dc_trace.f90

Go to the documentation of this file.

! -*- mode: f90; coding: utf-8 -*-
!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Yasuhiro MORIKAWA, Eizi TOYODA
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Debug tracing module
!> @details
!> dc_trace is a module that provides subroutines to assist in tracing
!> causes during debugging. By using this module, you can output debug
!> messages that show the hierarchical structure of subroutines as follows:
!>
!> @code
!>      :
!> #call HistoryPut0
!> #| call HistoryPutEx : time
!> #| | call TimeGoAhead : varname=time head=1.
!> #| | | call lookup_dimension
!> #| | | | call gtvarinquire : var.mapid=1
!> #| | | | | call gdncvarinqurie : var.id=1
!> #| | | | | end gdncvarinqurie : ok
!> #| | | | |-name=time
!> #| | | | end gtvarinquire
!> #| | | end lookup_dimension : ord=1
!> #| | end TimeGoAhead
!> #| end HistoryPutEx
!> #end HistoryPut0
!>      :
!> @endcode
!>
!> @section dc_trace_procedures Procedures List
!>
!> | Procedure   | Description                              |
!> |-------------|------------------------------------------|
!> | SetDebug    | Turn debug mode on/off                   |
!> | BeginSub    | Output subprogram start message          |
!> | EndSub      | Output subprogram end message            |
!> | DbgMessage  | Output debug message                     |
!> | DataDump    | Output multi-dimensional data            |
!>
!> @section dc_trace_usage Usage
!>
!> Use BeginSub and EndSub at the beginning and end of subprogram execution:
!>
!> @code{.f90}
!> subroutine TestRoutine(file, var, times, url)
!>   use dc_types,  only: STRING
!>   use dc_trace,  only: BeginSub, EndSub
!>   character(*), intent(in) :: file, var
!>   integer, intent(in) :: times
!>   character(*), intent(out):: url
!>   character(STRING), parameter:: subname = "TestRoutine"
!> continue
!>   call BeginSub(subname, 'file=%c, var=%c, times=%d', &
!>     &           c1=trim(file), c2=trim(var), i=(/times/) )
!>   url = trim(file) // trim(var)
!>   call EndSub(subname, 'url=%c', c1=trim(url) )
!> end subroutine TestRoutine
!> @endcode
!>
!> Call SetDebug at the beginning of the main program:
!>
!> @code{.f90}
!> program main
!>   use dc_trace, only: SetDebug
!> continue
!>   call SetDebug
!>   call TestRoutine(...)
!> end program main
!> @endcode
!>
!> @enden
!>
!> @ja
!> @brief デバッグ時の追跡用モジュール
!> @details
!> dc_trace はデバッグ時の原因の追跡を補助するためのサブルーチン群
!> を持つモジュールです。このモジュールを利用する事で、
!> 以下のようにサブルーチンの階層構造がそのまま分かるような
!> デバッグメッセージを出力する事が可能です。
!>
!> @code
!>      :
!> #call HistoryPut0
!> #| call HistoryPutEx : time
!> #| | call TimeGoAhead : varname=time head=1.
!> #| | | call lookup_dimension
!> #| | | | call gtvarinquire : var.mapid=1
!> #| | | | | call gdncvarinqurie : var.id=1
!> #| | | | | end gdncvarinqurie : ok
!> #| | | | |-name=time
!> #| | | | end gtvarinquire
!> #| | | end lookup_dimension : ord=1
!> #| | end TimeGoAhead
!> #| end HistoryPutEx
!> #end HistoryPut0
!>      :
!> @endcode
!>
!> @section dc_trace_procedures_ja 手続一覧
!>
!> | 手続名      | 説明                                     |
!> |-------------|------------------------------------------|
!> | SetDebug    | デバッグモードをオンオフ                 |
!> | BeginSub    | 副プログラム開始のメッセージ出力         |
!> | EndSub      | 副プログラム終了のメッセージ出力         |
!> | DbgMessage  | デバッグ用メッセージ出力                 |
!> | DataDump    | 多次元データ出力                         |
!>
!> @section dc_trace_usage_ja 使用方法
!>
!> 副プログラムの実行文の先頭と最後で BeginSub と EndSub を使用します。
!>
!> @code{.f90}
!> subroutine TestRoutine(file, var, times, url)
!>   use dc_types,  only: STRING
!>   use dc_trace,  only: BeginSub, EndSub
!>   character(*), intent(in) :: file, var
!>   integer, intent(in) :: times
!>   character(*), intent(out):: url
!>   character(STRING), parameter:: subname = "TestRoutine"
!> continue
!>   call BeginSub(subname, 'file=%c, var=%c, times=%d', &
!>     &           c1=trim(file), c2=trim(var), i=(/times/) )
!>   url = trim(file) // trim(var)
!>   call EndSub(subname, 'url=%c', c1=trim(url) )
!> end subroutine TestRoutine
!> @endcode
!>
!> 主プログラムの実行文の先頭で SetDebug を使用します。
!>
!> @code{.f90}
!> program main
!>   use dc_trace, only: SetDebug
!> continue
!>   call SetDebug
!>   call TestRoutine(...)
!> end program main
!> @endcode
!>
!> @note BeginSub よりも前に SetDebug が呼ばれている必要があります。
!> @note BeginSub と同じ回数だけ EndSub が呼ばれていなければなりません。
!>
!> @endja
!>
module dc_trace
  use dc_types, only: token, string
  implicit none
  private
  logical, save         :: lfirst = .true.
                                        ! 初回フラグ
  integer, save, public :: dbg = -1     ! SetDebug で設定された
                                        ! デバッグメッセージの
                                        ! 出力される装置番号です。
  integer, save         :: level = 0    ! サブルーチンレベル
  integer, parameter    :: trace_stack_size = 128
                                        ! 最大階層数
  character(TOKEN), save:: table(trace_stack_size)
                                        ! 階層⇔プログラム名
  character(STRING), save, allocatable:: called_subname(:), &
    &                                    called_subname_tmp(:)
                                        ! 既に一度呼ばれており,
                                        ! *version* 引数を指定している
                                        ! 副プログラム名を格納する配列
  character(1), parameter:: head    = '#'  ! 行頭文字
  character(2), parameter :: indent  = '| ' ! 字下げ文字
  character(2), parameter :: meshead = '|-' ! DbgMessage 用行頭文字
  public:: beginsub, endsub, debug, setdebug, dbgmessage, dbg_scratch
  public:: sublevel, datadump
  interface debug
    module procedure dctracedebug
  end interface
  interface datadump
    module procedure datad1dump, datad2dump, datad3dump
  end interface
contains
  !> @en
  !> @brief Return the hierarchical level of subprograms
  !> @details
  !> Returns the hierarchical level of subprograms. The default level is 0.
  !> The level increases by 1 with BeginSub and decreases by 1 with EndSub.
  !>
  !> @return Hierarchical level of subprograms
  !> @enden
  !>
  !> @ja
  !> @brief 副プログラムの階層レベルを返す
  !> @details
  !> 副プログラムの階層レベルを返します。レベルのデフォルトは 0 で、
  !> BeginSub によりレベルは 1 増え、EndSub によりレベルは 1 減ります。
  !>
  !> @return 副プログラムの階層レベル
  !> @endja
  integer function sublevel() result(result)
    result = level
  end function sublevel
  !> @en
  !> @brief Erase debug messages
  !> @details
  !> **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.
  !>
  !> @param[in] on If .true., erase subsequent debug messages.
  !>               If .false., output erased messages and resume normal output.
  !> @enden
  !>
  !> @ja
  !> @brief デバッグメッセージの抹消
  !> @details
  !> **動作未確認ですので利用の際にはご注意下さい。**
  !>
  !> 論理型変数 `on` に .true. を与える事で、
  !> 以降のデバッグメッセージを抹消する事が出来ます。
  !>
  !> なお、論理型変数 `on` に .false. を与える事で、
  !> 直前に呼んだ Dbg_Scratch 以降のメッセージを
  !> デバッグメッセージとして再び出力し、
  !> 以降のデバッグメッセージも出力されるようにします。
  !>
  !> @param[in] on .true. の場合、以降のデバッグメッセージを抹消する。
  !>               .false. の場合、抹消されたメッセージを出力し、通常出力を再開する。
  !> @endja
  subroutine dbg_scratch(on)
    logical, intent(in):: on
    integer, save:: saved_dbg = -1
    logical:: x, p
    character(80):: line
    integer:: ios
  continue
    if (on) then
      if (dbg < 0) return
      saved_dbg = dbg
      ! 有効な 1 〜 99 の装置番号の内の大きめの値を設定 (?)
      dbg = 98
      do
        inquire(unit=dbg, exist=x, opened=p)
        ! 装置番号 dbg が接続可能で、かつ未接続の場合
        if (x .and. .not. p) then
          ! 装置番号 deg をスクラッチファイルとして開く。
          !   ※ スクラッチファイルとは、特殊な外部ファイルである。
          !      これは名前なしの一時ファイルであり、開いている
          !      間だけ存在する。つまり、プログラムが終了すると
          !      存在しなくなる。
          open(unit=dbg, status='SCRATCH')
          ! 開く事が出来ればそれで終了。
          return
        endif
        ! 装置番号 dbg が利用不可、または利用済の場合は 0 以下に
        ! なるまで dbg - 1 して繰り返す。
        dbg = dbg - 1
        if (dbg < 0) exit
      enddo
      ! 装置番号 dbg が開けない場合、dbg と saved_dbg を初期化
      dbg = saved_dbg
      saved_dbg = -1
    else
      ! 以前に装置番号 dbg = 98〜0 でスクラッチファイルを開けてい
      ! なければそれで終了
      if (saved_dbg < 0) return
      ! 装置番号 dbg に接続されたスクラッチファイルをその開始位置
      ! に位置付ける。エラーが生じたら「100 continue」へ
      rewind(dbg, err=100)
      do
        ! 装置番号 dbg に接続されたスクラッチファイルの一行を
        ! line へ
        read(dbg, '(A)', iostat=ios) line
        if (ios /= 0) exit
        ! line を装置番号 saved_dbg へ書き出す。
        write(saved_dbg, '(A)', iostat=ios) trim(line)
        if (ios /= 0) exit
      enddo
  100 continue
      close(dbg, iostat=ios)
      ! 最後に dbg と saved_dbg を初期化
      dbg = saved_dbg
      saved_dbg = -1
    endif
  end subroutine dbg_scratch
  !> @en
  !> @brief Turn debug mode on/off
  !> @details
  !> 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
  !>
  !> @param[in] debug Unit number for debug message output (optional).
  !>            If not given, standard error output is used.
  !>            If negative, debug mode is disabled.
  !> @enden
  !>
  !> @ja
  !> @brief デバッグモードをオンオフ
  !> @details
  !> デバッグメッセージを出力したい時にこのサブルーチンを呼びます。
  !>
  !> 整数型変数 `debug` が与えられる場合は、その装置番号 debug に、
  !> 以降のサブルーチンによるデバッグメッセージを出力するようにします。
  !> `debug` が与えられない場合、装置番号 0 (標準エラー出力)
  !> にデバッグメッセージが出力されるようになります。
  !> 装置番号 0 への出力が成功しない場合は代わりに
  !> 装置番号 6 (標準出力) にデバッグメッセージが出力されるようになります。
  !>
  !> `debug` に負の整数を与える場合、デバッグモードが解除され、
  !> 以降デバッグメッセージは出力されません。
  !>
  !> なお、この SetDebug を呼んだ際にも、装置番号 debug
  !> に以下のメッセージが表示されます。
  !>
  !>     #SetDebug: dbg = debug
  !>
  !> @param[in] debug デバッグメッセージ出力用の装置番号 (省略可)。
  !>            省略時は標準エラー出力を使用。負の値を与えるとデバッグモード解除。
  !> @endja
  subroutine setdebug(debug)
    use dc_types, only: stdout, stderr
    implicit none
    integer, intent(in), optional:: debug
    integer:: ios
  continue
    if (present(debug)) then
      ! debug が与えられる時は装置番号として deg を用いる。
      dbg = debug
      write(dbg, "(A, 'SetDebug: dbg =', i4)", iostat=ios) &
        & trim(head), dbg
      if (ios == 0) return
    else
      ! debug が与えられ無い時は装置番号 0 (標準エラー出力)
      dbg = stderr
      write(dbg, "(A, 'SetDebug: dbg = ', I0)", iostat=ios) trim(head), dbg
      if (ios == 0) return
      ! 装置番号 0 への出力が失敗したら装置番号 6 (標準出力)
      dbg = stdout
      write(dbg, "(A, 'SetDebug: dbg = ', I0)", iostat=ios) trim(head), dbg
      if (ios == 0) return
    endif
    ! 例外処理として dbg の初期化
    dbg = -1
  end subroutine setdebug
  !> @en
  !> @brief Check if debug mode is enabled
  !> @details
  !> Returns .true. if debug mode is enabled by SetDebug,
  !> .false. if debug mode is not enabled.
  !>
  !> @param[out] dbg_mode .true. if debug mode is enabled, .false. otherwise
  !> @enden
  !>
  !> @ja
  !> @brief デバックモードかどうかの診断
  !> @details
  !> SetDebug でデバッグモードになっている場合には .true. が、
  !> デバッグモードでない場合には .false. が返ります。
  !>
  !> @param[out] dbg_mode デバッグモードの場合 .true.、そうでなければ .false.
  !> @endja
  subroutine dctracedebug(dbg_mode)
    logical, intent(out):: dbg_mode
    dbg_mode = dbg >= 0
  end subroutine dctracedebug
  !> @brief Initialize internal variables
  subroutine initialize
    table(:) = ' '
    lfirst = .false.
  end subroutine initialize
  !> @en
  !> @brief Output subprogram start message
  !> @details
  !> 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.
  !>
  !> @param[in] name Subprogram name
  !> @param[in] fmt Format string for additional message (optional)
  !> @param[in] i Integer array for formatting
  !> @param[in] r Real array for formatting
  !> @param[in] d Double precision array for formatting
  !> @param[in] L Logical array for formatting
  !> @param[in] n Integer array for formatting
  !> @param[in] c1 Character string 1 for formatting
  !> @param[in] c2 Character string 2 for formatting
  !> @param[in] c3 Character string 3 for formatting
  !> @param[in] ca Character array for formatting
  !> @param[in] version Version number of the subprogram (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 副プログラム開始のメッセージ出力
  !> @details
  !> 文字型変数 `name` に与えた副プログラム名を以下のように出力します。
  !>
  !>     # call name
  !>
  !> 複数回呼ぶ事で階層構造が分かるメッセージが出力されます
  !> (dc_trace の Overview 参照)。
  !> 必ず BeginSub と同様な数だけ EndSub を呼ぶようにしてください。
  !>
  !> `fmt` およびそれ以降の引数を与える事で、付加メッセージも出力可能です:
  !>
  !>     # call name : fmt
  !>
  !> 書式は dc_string::CPrintf を参照して下さい。
  !>
  !> `version` には副プログラムのバージョンナンバーを与えます。
  !> version に与えられた文字列は、初回に呼び出された時のみ表示されます。
  !>
  !> @note このサブルーチンにより内部変数 level の値が 1 増えます。
  !>
  !> @param[in] name 副プログラム名
  !> @param[in] fmt 付加メッセージ用フォーマット文字列 (省略可)
  !> @param[in] i フォーマット用整数配列
  !> @param[in] r フォーマット用実数配列
  !> @param[in] d フォーマット用倍精度実数配列
  !> @param[in] L フォーマット用論理配列
  !> @param[in] n フォーマット用整数配列
  !> @param[in] c1 フォーマット用文字列1
  !> @param[in] c2 フォーマット用文字列2
  !> @param[in] c3 フォーマット用文字列3
  !> @param[in] ca フォーマット用文字列配列
  !> @param[in] version 副プログラムのバージョンナンバー (省略可)
  !> @endja
  subroutine beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, &
    & version)
    use dc_types, only: string, dp
    use dc_string, only: cprintf, strinclude
    character(*), intent(in)          :: name
    character(*), intent(in), optional:: fmt
    integer,      intent(in), optional:: i(:), n(:)
    real,         intent(in), optional:: r(:)
    real(dp),     intent(in), optional:: d(:)
    logical,      intent(in), optional:: l(:)
    character(*), intent(in), optional:: c1, c2, c3
    character(*), intent(in), optional:: ca(:)
    character(*), intent(in), optional:: version
    character(STRING) :: cbuf
    character(STRING) :: name_ver
    logical :: dbg_mode, print_version
    integer :: alloc_size
  continue
    if ( dbg < 0 ) return
    if (lfirst) call initialize
    call debug( dbg_mode )
    if ( dbg_mode ) then
      name_ver = name
      print_version = .false.
      !---------------------------------
      !  Print Version check
      if (present(version)) then
        if (.not. allocated(called_subname)) then
          allocate(called_subname(1))
          called_subname(1) = name
          print_version = .true.
        else
          if (.not. strinclude(called_subname, trim(name))) then
            alloc_size = size(called_subname)
            allocate(called_subname_tmp(alloc_size))
            called_subname_tmp = called_subname
            deallocate(called_subname)
            allocate(called_subname(alloc_size + 1))
            called_subname(1:alloc_size) = called_subname_tmp
            deallocate(called_subname_tmp)
            called_subname(alloc_size + 1) = name
            print_version = .true.
          end if
        end if
        if (print_version) then
          name_ver = cprintf('%c version=<%c>', &
            & c1=trim(name), c2=trim(version))
        end if
      end if
      !---------------------------------
      !  Print Debug message
      if (present(fmt)) then
        cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
        write(dbg, "(A, A, 'call ', A, ' : ', A)") trim(head), &
          & repeat(indent, level), trim(name_ver), trim(cbuf)
      else
        write(dbg, "(A, A, 'call ',A)") trim(head), &
          & repeat(indent, level), trim(name_ver)
      endif
    endif
    ! call errtra ! --- for Fujitsu debug
    if (level > size(table)) return
    level = level + 1
    table(level) = name
  end subroutine beginsub
  !> @en
  !> @brief Output subprogram end message
  !> @details
  !> 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.
  !>
  !> @param[in] name Subprogram name
  !> @param[in] fmt Format string for additional message (optional)
  !> @param[in] i Integer array for formatting
  !> @param[in] r Real array for formatting
  !> @param[in] d Double precision array for formatting
  !> @param[in] L Logical array for formatting
  !> @param[in] n Integer array for formatting
  !> @param[in] c1 Character string 1 for formatting
  !> @param[in] c2 Character string 2 for formatting
  !> @param[in] c3 Character string 3 for formatting
  !> @param[in] ca Character array for formatting
  !> @enden
  !>
  !> @ja
  !> @brief 副プログラム終了のメッセージ出力
  !> @details
  !> 文字型変数 `name` に与えた副プログラム名を以下のように出力します。
  !>
  !>     # end name
  !>
  !> BeginSub に対して一対一対応していますので、name には対応する
  !> BeginSub の引数 name と同じものを与えて下さい。
  !>
  !> `fmt` およびそれ以降の引数を与える事で、付加メッセージも出力可能です:
  !>
  !>     # end name fmt
  !>
  !> 書式は dc_string::CPrintf を参照して下さい。
  !>
  !> @note このサブルーチンにより内部変数 level の値が 1 減ります。
  !>
  !> @param[in] name 副プログラム名
  !> @param[in] fmt 付加メッセージ用フォーマット文字列 (省略可)
  !> @param[in] i フォーマット用整数配列
  !> @param[in] r フォーマット用実数配列
  !> @param[in] d フォーマット用倍精度実数配列
  !> @param[in] L フォーマット用論理配列
  !> @param[in] n フォーマット用整数配列
  !> @param[in] c1 フォーマット用文字列1
  !> @param[in] c2 フォーマット用文字列2
  !> @param[in] c3 フォーマット用文字列3
  !> @param[in] ca フォーマット用文字列配列
  !> @endja
  subroutine endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
    use dc_types, only: dp
    use dc_string, only: cprintf
    character(*), intent(in)          :: name
    character(*), intent(in), optional:: fmt
    integer,      intent(in), optional:: i(:), n(:)
    real,         intent(in), optional:: r(:)
    real(dp),     intent(in), optional:: d(:)
    logical,      intent(in), optional:: l(:)
    character(*), intent(in), optional:: c1, c2, c3
    character(*), intent(in), optional:: ca(:)
    character(STRING):: cbuf
    logical:: debug_mode
  continue
    if ( dbg < 0 ) return
    if (lfirst) call initialize
    ! call errtra ! --- for Fujitsu debug
    if (level <= 0) then
      write(*, "(A, 'Warning EndSub[',A,'] without BeginSub')") &
        & trim(head), trim(name)
    else if (name /= table(level)) then
      write(*, "(A, 'Warning EndSub[',A,'] but tos[',A,']')") &
        & trim(head), trim(name), trim(table(level))
    else
      level = level - 1
    endif
    call debug( debug_mode )
    if ( debug_mode ) then
      if (present(fmt)) then
        cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
        write(dbg, "(A, A, 'end ', A, ' : ', A)") trim(head), &
          & repeat(indent, level), trim(name), trim(cbuf)
      else
        write(dbg, "(A, A, 'end ', A)") trim(head), &
          & repeat(indent, level), trim(name)
      endif
    endif
  end subroutine endsub
  !> @en
  !> @brief Output debug message
  !> @details
  !> 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`.
  !>
  !> @param[in] fmt Format string
  !> @param[in] i Integer array for formatting
  !> @param[in] r Real array for formatting
  !> @param[in] d Double precision array for formatting
  !> @param[in] L Logical array for formatting
  !> @param[in] n Integer array for formatting
  !> @param[in] c1 Character string 1 for formatting
  !> @param[in] c2 Character string 2 for formatting
  !> @param[in] c3 Character string 3 for formatting
  !> @param[in] ca Character array for formatting
  !> @enden
  !>
  !> @ja
  !> @brief デバッグ用メッセージ出力
  !> @details
  !> フォーマット文字列 `fmt` に従ってデバッグメッセージを出力します。
  !> 書式は dc_string::CPrintf を参照して下さい。
  !>
  !> 利用例に関しては dc_trace の Example を参照して下さい。
  !>
  !> @note このサブルーチンを用いても内部変数 level の値は変化しません。
  !>
  !> @param[in] fmt フォーマット文字列
  !> @param[in] i フォーマット用整数配列
  !> @param[in] r フォーマット用実数配列
  !> @param[in] d フォーマット用倍精度実数配列
  !> @param[in] L フォーマット用論理配列
  !> @param[in] n フォーマット用整数配列
  !> @param[in] c1 フォーマット用文字列1
  !> @param[in] c2 フォーマット用文字列2
  !> @param[in] c3 フォーマット用文字列3
  !> @param[in] ca フォーマット用文字列配列
  !> @endja
  subroutine dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
    use dc_types, only: string, dp
    use dc_string, only: cprintf, tochar
    character(*), intent(in)          :: fmt
    integer,      intent(in), optional:: i(:), n(:)
    real,         intent(in), optional:: r(:)
    real(dp),     intent(in), optional:: d(:)
    logical,      intent(in), optional:: l(:)
    character(*), intent(in), optional:: c1, c2, c3
    character(*), intent(in), optional:: ca(:)
    character(STRING):: cbuf
    character(STRING):: meshead_tmp
    integer          :: meshead_len
  continue
    if ( dbg < 0 ) return
    cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
    if (level < 1) then
      meshead_tmp = ''
      meshead_len = 0
    else
      meshead_tmp = meshead
      meshead_len = len(meshead)
    endif
    write(dbg, "(A, A, A, A)") &
      & trim(head), repeat( indent, max(level-1, 0) ), &
      & meshead_tmp(1:meshead_len), trim(cbuf)
  end subroutine dbgmessage
  !> @en
  !> @brief Output 1-dimensional data
  !> @details
  !> Outputs multi-dimensional data `d` (double precision real) as debug messages.
  !> The character variable `header` is used as a prefix for output.
  !> By providing `strlen`, you can specify the number of characters per line
  !> (default is dc_types::STRING).
  !> By providing `multi(:)`, you can add dimension subscripts after the header.
  !>
  !> See dc_trace Example for usage examples.
  !>
  !> @note This subroutine does not change the internal variable `level`.
  !>
  !> @param[in] header Data name (prefix for output)
  !> @param[in] d 1-dimensional double precision real data
  !> @param[in] strlen Number of characters per line (optional)
  !> @param[in] multi Higher dimension subscripts (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 1 次元データ出力
  !> @details
  !> デバッグメッセージとして、多次元データ `d` (倍精度実数型) を出力します。
  !> 文字型変数 `header` は出力時の頭文字として利用されます。
  !> `strlen` を与える事で、一行の文字数を指定できます
  !> (デフォルトは dc_types::STRING)。
  !> `multi(:)` を与えることで、header の後ろに次元添字をつける事が可能です。
  !>
  !> 利用例に関しては dc_trace の Example を参照して下さい。
  !>
  !> @note このサブルーチンを用いても内部変数 level の値は変化しません。
  !>
  !> @param[in] header データの名称 (出力時の接頭辞)
  !> @param[in] d 倍精度実数１次元データ
  !> @param[in] strlen 一行の文字数 (省略可)
  !> @param[in] multi 上位の次元添字 (省略可)
  !> @endja
  subroutine datad1dump(header, d, strlen, multi)
    use dc_types,      only: string, dp
    use dc_string,     only: tochar
    character(*), intent(in)          :: header
    real(DP),     intent(in)          :: d(:)
    integer,      intent(in), optional:: strlen
    integer,      intent(in), optional:: multi(:)
    integer          :: i, j
    character(STRING):: unit    ! データ文字列
    character(STRING):: unitbuf ! データ文字列バッファ
    integer          :: ucur    ! unit に書かれた文字数
    character(STRING):: cbuf    ! read/write 文のバッファ
    integer          :: stat    ! ステータス
    logical  :: first  ! 1つ目のデータかどうか
    integer  :: begini ! 1つ目のデータの添字
    integer  :: endi   ! 最後のデータの添字
    character(STRING):: cmulti ! 次元添字用文字列
    character(STRING):: cout   ! 出力する文字列
    character(STRING):: meshead_tmp
    integer          :: meshead_len
  continue
    if ( dbg < 0 ) return
    ! 初期化
    unit    = ''
    unitbuf = ''
    ucur    = 0
    stat    = 0
    first = .true.
    cmulti = ''
    ! デバッグメッセージヘッダの作成。
    if (level < 1) then
      meshead_tmp = ''
      meshead_len = 0
    else
      meshead_tmp = meshead
      meshead_len = len(meshead)
    endif
    ! 次元添字用文字列を作成
    if (present(multi)) then
      do j = 1, size(multi)
        cmulti = trim(cmulti) // ', ' // trim(  tochar( multi(j) )  )
      enddo
    endif
    i = 1
    dim_1_loop : do
      if (first) begini = i
      endi = i
      write(cbuf, "(g40.20)") d(i)
      if (.not. first) cbuf = ', ' // adjustl(cbuf(1:254))
      unitbuf = unit
      call append(unit, ucur, trim(adjustl(cbuf)), stat, strlen)
      if ( stat /= 0 .or. i == size( d(:) ) ) then
        ! 一回目は、文字数オーバーでもそのまま出力。
        if (first) then
          cout = header // '(' &
            &   // trim(tochar(begini)) &
            &   // trim(cmulti) &
            &   // ')=' // trim(unit)
          ! 二回目以降は、オーバーしたものは次回へ
        elseif (stat /= 0 .and. begini == endi-1) then
          cout = header // '(' &
            &   // trim(tochar(begini)) &
            &   // trim(cmulti) &
            &   // ')='// trim(unitbuf)
          ! 1つ巻戻す
          i = i - 1
        elseif (stat /= 0 .and. begini /= endi-1) then
          cout = header // '(' &
            &   // trim(tochar(begini)) // '-' &
            &   // trim(tochar(endi-1)) &
            &   // trim(cmulti) &
            &   // ')=' // trim(unitbuf)
          ! 1つ巻戻す
          i = i - 1
          ! i が size(d) まで到達した場合もそのまま出力。
        elseif ( i == size( d(:) ) ) then
          cout = header // '(' &
            &   // trim(tochar(begini)) // '-' &
            &   // trim(tochar(endi))   &
            &   // trim(cmulti) &
            &   // ')='// trim(unit)
        endif
        write(dbg, "(A, A, A, A)") &
          & trim(head), repeat( indent, max(level-1, 0) ), &
          & meshead_tmp(1:meshead_len), trim(cout)
        ! unit, unitbuf をクリア
        unit    = ''
        unitbuf = ''
        ucur    = 0
        first = .true.
      else
        first = .false.
      endif
      if (i == size( d(:) ) ) exit dim_1_loop
      i = i + 1
    enddo dim_1_loop
  end subroutine datad1dump
  !> @en
  !> @brief Output 2-dimensional data
  !> @details
  !> See DataDump or DataD1Dump for details.
  !>
  !> @param[in] header Data name (prefix for output)
  !> @param[in] d 2-dimensional double precision real data
  !> @param[in] strlen Number of characters per line (optional)
  !> @param[in] multi Higher dimension subscripts (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 2 次元データ出力
  !> @details
  !> 詳しくは DataDump または DataD1Dump を参照ください。
  !>
  !> @param[in] header データの名称
  !> @param[in] d 倍精度実数２次元データ
  !> @param[in] strlen 一行の文字数 (省略可)
  !> @param[in] multi 上位の次元添字 (省略可)
  !> @endja
  subroutine datad2dump(header, d, strlen, multi)
    use dc_types,      only: dp
    character(*), intent(in)          :: header
    real(DP),     intent(in)          :: d(:,:)
    integer,      intent(in), optional:: strlen
    integer,      intent(in), optional:: multi(:)
    integer, allocatable :: total(:)
    integer              :: j
  continue
    if ( dbg < 0 ) return
    if (present(multi)) then
      allocate( total(size(multi)+1) )
      total(2:size(multi)+1) = multi(:)
    else
      allocate( total(1) )
    endif
    do j = 1, size( d(:,:), 2 )
      total(1) = j
      call datadump(header, d(:,j), strlen=strlen, multi=total(:))
    enddo
    deallocate( total )
  end subroutine datad2dump
  !> @en
  !> @brief Output 3-dimensional data
  !> @details
  !> See DataDump or DataD1Dump for details.
  !>
  !> @param[in] header Data name (prefix for output)
  !> @param[in] d 3-dimensional double precision real data
  !> @param[in] strlen Number of characters per line (optional)
  !> @param[in] multi Higher dimension subscripts (optional)
  !> @enden
  !>
  !> @ja
  !> @brief 3 次元データ出力
  !> @details
  !> 詳しくは DataDump または DataD1Dump を参照ください。
  !>
  !> @param[in] header データの名称
  !> @param[in] d 倍精度実数３次元データ
  !> @param[in] strlen 一行の文字数 (省略可)
  !> @param[in] multi 上位の次元添字 (省略可)
  !> @endja
  subroutine datad3dump(header, d, strlen, multi)
    use dc_types,      only: dp
    character(*), intent(in)          :: header
    real(DP),     intent(in)          :: d(:,:,:)
    integer,      intent(in), optional:: strlen
    integer,      intent(in), optional:: multi(:)
    integer, allocatable :: total(:)
    integer              :: k
  continue
    if ( dbg < 0 ) return
    if (present(multi)) then
      allocate( total(size(multi)+1) )
      total(2:size(multi)+1) = multi(:)
    else
      allocate( total(1) )
    endif
    do k = 1, size( d(:,:,:), 3 )
      total(1) = k
      call datadump(header, d(:,:,k), strlen=strlen, multi=total(:))
    enddo
    deallocate( total )
  end subroutine datad3dump
  !> @en
  !> @brief Internal function for DataD1Dump
  !> @details
  !> Appends `val` to `unit`. If `unit` exceeds its maximum string length,
  !> returns stat = 2.
  !>
  !> @param[in,out] unit Final string to be returned
  !> @param[in,out] ucur Number of characters in unit
  !> @param[in] val String to be appended to unit
  !> @param[out] stat Status (0: success, 1: truncated, 2: overflow)
  !> @param[in] strlen Manual specification of character count (optional)
  !> @enden
  !>
  !> @ja
  !> @brief DataD1Dump の内部関数
  !> @details
  !> unit に val を付加。その際、unit がその最大文字列長を越えた場合
  !> には stat = 2 を返す。
  !>
  !> @param[in,out] unit 最終的に返される文字列
  !> @param[in,out] ucur unit の文字数
  !> @param[in] val unit に付加される文字列
  !> @param[out] stat ステータス (0: 成功, 1: 切り捨て, 2: オーバーフロー)
  !> @param[in] strlen 文字数の手動指定 (省略可)
  !> @endja
  subroutine append(unit, ucur, val, stat, strlen)
    character(*), intent(inout):: unit
    integer,      intent(inout):: ucur
    character(*), intent(in)   :: val
    integer,      intent(out)  :: stat
    integer,      intent(in), &
      &        optional     :: strlen
    integer                    :: wrsz ! val の文字列
    continue
    ! unit の最大長を越えた場合には stat = 2 を返す。
    if (present(strlen)) then
      if (ucur >= strlen) then
        stat = 2
        return
      endif
    else
      if (ucur >= len(unit)) then
        stat = 2
        return
      endif
    endif
    ! 正常時の処理。
    ! unit の長さを越えた場合も考慮して unit に val を付加する。
    wrsz = min(len(val), len(unit) - ucur)
    unit(1+ucur: wrsz+ucur) = val(1: wrsz)
    ucur = ucur + wrsz
    stat = 0
    if (wrsz < len(val)) stat = 1
  end subroutine append
  !> @namespace dc_trace
end module dc_trace