!= ãƒ‡ãƒãƒƒã‚°æ™‚ã®è¿½è·¡ç”¨ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: dc_trace.F90,v 1.3 2010-04-11 14:13:51 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_trace
!
module dc_trace
  !
  != ãƒ‡ãƒãƒƒã‚°æ™‚ã®è¿½è·¡ç”¨ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«
  !
  ! dc_trace ã¯ãƒ‡ãƒãƒƒã‚°æ™‚ã®åŽŸå› ã®è¿½è·¡ã‚’è£œåŠ©ã™ã‚‹ãŸã‚ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ç¾¤
  ! ã‚’æŒã¤ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã§ã™ã€‚ ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã‚’åˆ©ç”¨ã™ã‚‹äº‹ã§ã€
  ! ä»¥ä¸‹ã®ã‚ˆã†ã«ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®éšŽå±¤æ§‹é€ ãŒãã®ã¾ã¾åˆ†ã‹ã‚‹ã‚ˆã†ãª
  ! ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã™ã‚‹äº‹ãŒå¯èƒ½ã§ã™ã€‚
  !
  !         :
  !    #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
  !    #| | | call gtvarslice : var%mapid=1 dimord=1
  !    #| | | |-[gt_variable 1: ndims=1, map.size=1]
  !    #| | | |-[dim1 dimno=1 ofs=0 step=1 all=0 start=1 count=0 stride=1 url=]
  !    #| | | |-[vartable 1: class=netcdf cid=1 ref=1]
  !    #| | | |-[GD_NC_VARIABLE(file=3, var=1, dim=1)]
  !    #| | | |-map(dimord): originally start=1 count=0 stride=1
  !    #| | | |-start=1 (1 specified)
  !    #| | | |-count=1 (1 specified)
  !    #| | | end gtvarslice
  !    #| | end TimeGoAhead
  !    #| |-gdncfiledefinemode
  !    #| end HistoryPutEx
  !    #end HistoryPut0
  !         :
  !
  !== Tutorial
  !
  ! * gtool5 ã‚ªãƒ•ã‚£ã‚·ãƒ£ãƒ«ãƒãƒ¥ãƒ¼ãƒˆãƒªã‚¢ãƒ«:
  !   {ãƒ‡ãƒãƒƒã‚°è£œåŠ©}[link:../tutorial/dc_trace.htm]
  !
  !== Procedures list
  !
  ! SetDebug    :: ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã‚’ã‚ªãƒ³ã‚ªãƒ•
  ! BeginSub    :: å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ é–‹å§‹ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
  ! EndSub      :: å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ çµ‚äº†ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
  ! DbgMessage  :: ãƒ‡ãƒãƒƒã‚°ç”¨ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
  !
  !== Usage
  !
  ! dc_trace ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«ã‚’åˆ©ç”¨ã™ã‚‹ãŸã‚ã®ä¸€é€£ã®æµã‚Œã‚’è§£èª¬ã—ã¾ã™ã€‚
  ! è©³ã—ãã¯å„æ‰‹ç¶šãã®è©³ç´°ã‚’å‚ç…§ã—ã¦ãã ã•ã„ã€‚
  !
  ! ã¾ãšã€ä»¥ä¸‹ã®ä¾‹ã®ã‚ˆã†ã«å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®å®Ÿè¡Œæ–‡ã®å…ˆé ã¨æœ€å¾Œã§
  ! BeginSub ã¨ EndSub ã‚’ä½¿ç”¨ã—ã¾ã™ã€‚
  !
  !     subroutine TestRoutine(file, var, times, db, url)
  !       use dc_types,  only: STRING, DP
  !       use dc_trace,  only: BeginSub, EndSub
  !       character(len = *), intent(in) :: file, var
  !       integer           , intent(in) :: times
  !       real(DP)          , intent(in) :: db(5)
  !       character(len = *), intent(out):: url
  !       character(len = 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) // ' ' // ','
  !       url = repeat(trim(url), times)
  !
  !       call EndSub(subname, 'url=%c', c1=trim(url) )
  !     end subroutine TestRoutine
  !
  ! ãã—ã¦ã€ä¸»ãƒ—ãƒã‚°ãƒ©ãƒ ã®å®Ÿè¡Œæ–‡ã®å…ˆé ã§ SetDebug ã‚’ä½¿ç”¨ã—ã¾ã™ã€‚
  ! å¼•æ•°ã¯å¿…é ˆã§ã¯ã‚ã‚Šã¾ã›ã‚“ãŒã€ãã®å ´åˆãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã¯
  ! æ¨™æº–ã‚¨ãƒ©ãƒ¼å‡ºåŠ›ã«è¡¨ç¤ºã•ã‚Œã¾ã™ã€‚ã‚‚ã—ã‚‚æ¨™æº–å‡ºåŠ›ãªã©ãã®ä»–ã¸
  ! å‡ºåŠ›ã—ãŸã„å ´åˆã¯å‡ºåŠ›ã—ãŸã„è£…ç½®ç•ªå·ã‚’å¼•æ•°ã¨ã—ã¦ä¸Žãˆã¦ãã ã•ã„ã€‚
  !
  !     program main
  !       use dc_types,  only: STRING, DP
  !       use dc_trace,  only: SetDebug
  !       character(len = STRING), parameter:: file    = 'test.nc'
  !       character(len = STRING), parameter:: var     = 'div'
  !       integer                , parameter:: times   = 2
  !       character(len = STRING)           :: url
  !       real(DP)                          :: db(5) = (/1.1, 2.2, 3.3, 4.4, 5.5/)
  !       character(len = STRING), parameter:: subname = "TestProgram"
  !
  !     continue
  !
  !       call SetDebug
  !
  !       call TestRoutine(file, var, times, db, url)
  !
  !       stop
  !     end program main
  !
  ! ä¸Šè¨˜ã®ãƒ—ãƒã‚°ãƒ©ãƒ ã‹ã‚‰ã¯ä»¥ä¸‹ã®ã‚ˆã†ãªãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ãŒ
  ! æ¨™æº–ã‚¨ãƒ©ãƒ¼å‡ºåŠ›ã«å‡ºåŠ›ã•ã‚Œã¾ã™ã€‚
  !
  !     #SetDebug: dbg = 0
  !     #call TestRoutine : file=test.nc, var=div, times=2
  !     #end TestRoutine : url=test.ncdiv ,test.ncdiv ,
  !
  ! ä»¥ä¸‹ã«æ³¨æ„ãŠã‚ˆã³è£œè¶³ã‚’è¨˜ã—ã¾ã™ã€‚
  !
  ! * ä¸Šè¨˜ã®ã‚ˆã†ã« BeginSub ã‚ˆã‚Šã‚‚å‰ã« SetDebug ãŒå‘¼ã°ã‚Œã¦ã„ã‚‹å¿…è¦ãŒã‚ã‚Šã¾ã™ã€‚
  ! * BeginSub ã¨åŒã˜å›žæ•°ã ã‘ EndSub ãŒå‘¼ã°ã‚Œã¦ã„ãªã‘ã‚Œã°ãªã‚Šã¾ã›ã‚“ã€‚
  ! * å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®æœ€åˆã¨æœ€å¾Œä»¥å¤–ã§ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸
  !   ã‚’å‡ºåŠ›ã—ãŸã„å ´åˆã«ã¯ DbgMessage ã‚’ç”¨ã„ã¦ä¸‹ã•ã„ã€‚
  ! * ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã¨ã—ã¦å¤šæ¬¡å…ƒãƒ‡ãƒ¼ã‚¿ã‚’å‡ºåŠ›ã—ãŸã„å ´åˆã¯
  !   DataDump ãŒã‚’ç”¨ã„ã¦ãã ã•ã„ã€‚
  ! * ç¾åœ¨ã®ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã®çŠ¶æ…‹ (ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã‹å¦ã‹ã€
  !   å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®æ·±åº¦ã€å‡ºåŠ›è£…ç½®ç•ªå·) ã‚’èª¿ã¹ãŸã„å ´åˆã¯ã€
  !   ãã‚Œãžã‚Œ Debug, SubLevel, dbg ã‚’åˆ©ç”¨ã—ã¦ãã ã•ã„ã€‚
  !
  !== Example
  !
  !     program main
  !       use dc_types,  only: STRING, DP
  !       use dc_trace,  only: SetDebug
  !       character(len = STRING), parameter:: file    = 'test.nc'
  !       character(len = STRING), parameter:: var     = 'div'
  !       integer                , parameter:: times   = 2
  !       character(len = STRING)           :: url
  !       real(DP)                          :: db(5) = (/1.1, 2.2, 3.3, 4.4, 5.5/)
  !       character(len = STRING), parameter:: subname = "TestProgram"
  !
  !     continue
  !
  !       call SetDebug
  !
  !       call TestRoutine(file, var, times, db, url)
  !
  !       stop
  !     end program main
  !
  !     subroutine TestRoutine(file, var, times, db, url)
  !       use dc_types,  only: STRING, DP
  !       use dc_trace,  only: BeginSub, EndSub
  !       character(len = *), intent(in) :: file, var
  !       integer           , intent(in) :: times
  !       real(DP)          , intent(in) :: db(5)
  !       character(len = *), intent(out):: url
  !       character(len = 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 DbgMessage('url=%c', c1=trim(url))
  !       url = repeat(trim(url), times)
  !       call DataDump('db', db, strlen=60)
  !
  !       call EndSub(subname, 'url=%c', c1=trim(url) )
  !     end subroutine TestRoutine
  !
  ! ä¸Šè¨˜ã®ãƒ—ãƒã‚°ãƒ©ãƒ ã‹ã‚‰ã¯ä»¥ä¸‹ã®ã‚ˆã†ãªãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ãŒ
  ! æ¨™æº–ã‚¨ãƒ©ãƒ¼å‡ºåŠ›ã«å‡ºåŠ›ã•ã‚Œã¾ã™ã€‚
  !
  !     #SetDebug: dbg = 0
  !     #call TestRoutine : file=test.nc, var=div, times=2
  !     #|-url=test.ncdiv ,
  !     #|-db(1-3)=1.1000000238418580000, 2.2000000476837160000, 3.2999999523162840000
  !     #|-db(4-5)=4.4000000953674320000, 5.5000000000000000000
  !     #end TestRoutine : url=test.ncdiv ,test.ncdiv ,
  !
  !
  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
  integer function SubLevel() result(result)
    !
    !== å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®éšŽå±¤ãƒ¬ãƒ™ãƒ«ã‚’è¿”ã™
    !
    ! å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®éšŽå±¤ãƒ¬ãƒ™ãƒ«ã‚’è¿”ã—ã¾ã™ã€‚ ãƒ¬ãƒ™ãƒ«ã®ãƒ‡ãƒ•ã‚©ãƒ«ãƒˆã¯ 0 ã§ã€
    ! BeginSub ã«ã‚ˆã‚Šãƒ¬ãƒ™ãƒ«ã¯ 1 å¢—ãˆã€ EndSub ã«ã‚ˆã‚Šãƒ¬ãƒ™ãƒ«ã¯ 1 æ¸›ã‚Šã¾ã™ã€‚
    !
    result = level
  end function SubLevel
  subroutine Dbg_Scratch(on)
    !
    !== ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã®æŠ¹æ¶ˆ
    !
    ! <b>å‹•ä½œæœªç¢ºèªã§ã™ã®ã§åˆ©ç”¨ã®éš›ã«ã¯ã”æ³¨æ„ä¸‹ã•ã„ã€‚</b>
    !
    ! è«–ç†åž‹å¤‰æ•° on ã« .true. ã‚’ä¸Žãˆã‚‹äº‹ã§ã€
    ! ä»¥é™ã® ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’æŠ¹æ¶ˆã™ã‚‹äº‹ãŒå‡ºæ¥ã¾ã™ã€‚
    !
    ! ãªãŠã€è«–ç†åž‹å¤‰æ•° on ã« <tt>.false.</tt> ã‚’ ä¸Žãˆã‚‹äº‹ã§ã€
    ! ç›´å‰ã«å‘¼ã‚“ã  Dbg_Scratch ä»¥é™ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’
    ! ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã¨ã—ã¦å†ã³å‡ºåŠ›ã—ã€
    ! ä»¥é™ã®ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚‚ å‡ºåŠ›ã•ã‚Œã‚‹ã‚ˆã†ã«ã—ã¾ã™ã€‚
    !
    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
  subroutine SetDebug(debug)
    use dc_types, only: STDOUT, STDERR
    implicit none
    !
    !== ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã‚’ã‚ªãƒ³ã‚ªãƒ•
    !
    ! ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã—ãŸã„æ™‚ã«ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’å‘¼ã³ã¾ã™ã€‚
    !
    ! æ•´æ•°åž‹å¤‰æ•° debug ãŒä¸Žãˆã‚‰ã‚Œã‚‹å ´åˆã¯ã€ãã®è£…ç½®ç•ªå· debug ã«ã€
    ! ä»¥é™ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã«ã‚ˆã‚‹ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã™ã‚‹ã‚ˆã†ã«ã—ã¾ã™ã€‚
    ! debug ãŒä¸Žãˆã‚‰ã‚Œãªã„å ´åˆã€è£…ç½®ç•ªå· 0 (æ¨™æº–ã‚¨ãƒ©ãƒ¼å‡ºåŠ›)
    ! ã«ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ãŒå‡ºåŠ›ã•ã‚Œã‚‹ã‚ˆã†ã«ãªã‚Šã¾ã™ã€‚
    ! è£…ç½®ç•ªå· 0 ã¸ã®å‡ºåŠ›ãŒæˆåŠŸã—ãªã„å ´åˆã¯ä»£ã‚ã‚Šã«
    ! è£…ç½®ç•ªå· 6 (æ¨™æº–å‡ºåŠ›) ã«ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ãŒå‡ºåŠ›ã•ã‚Œã‚‹ã‚ˆã†ã«ãªã‚Šã¾ã™ã€‚
    !
    ! debug ã«è² ã®æ•´æ•°ã‚’ä¸Žãˆã‚‹å ´åˆã€ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ãŒè§£é™¤ã•ã‚Œã€
    ! ä»¥é™ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã¯å‡ºåŠ›ã•ã‚Œã¾ã›ã‚“ã€‚
    !
    ! ãªãŠã€ã“ã® SetDebug ã‚’å‘¼ã‚“ã éš›ã«ã‚‚ã€è£…ç½®ç•ªå· debug
    ! ã«ä»¥ä¸‹ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ ãŒè¡¨ç¤ºã•ã‚Œã¾ã™ã€‚
    !
    !     #SetDebug: dbg = debug
    !
    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
  subroutine DCTraceDebug(dbg_mode)
    !
    !== ãƒ‡ãƒãƒƒã‚¯ãƒ¢ãƒ¼ãƒ‰ã‹ã©ã†ã‹ã®è¨ºæ–
    !
    ! SetDebugã§ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã«ãªã£ã¦ã„ã‚‹å ´åˆã«ã¯ .true. ãŒã€
    ! ãƒ‡ãƒãƒƒã‚°ãƒ¢ãƒ¼ãƒ‰ã§ãªã„å ´åˆã«ã¯ .false. ãŒè¿”ã‚Šã¾ã™ã€‚
    !
    logical, intent(out):: dbg_mode
    dbg_mode = dbg >= 0
  end subroutine DCTraceDebug
  subroutine initialize
    !
    ! åˆæœŸåŒ–
    !
    table(:) = ' '
    lfirst = .false.
  end subroutine initialize
  subroutine BeginSub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, &
    & version)
    !
    !== å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ é–‹å§‹ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
    !
    ! æ–‡å—åž‹å¤‰æ•° *name* ã«ä¸ŽãˆãŸå‰¯ãƒ—ãƒã‚°ãƒ©ãƒ åã‚’ä»¥ä¸‹ã®ã‚ˆã†ã«å‡ºåŠ›ã—ã¾ã™.
    !
    !     # call name
    !
    ! è¤‡æ•°å›žå‘¼ã¶äº‹ã§ä¸Šè¨˜ (dc_trace ã® Overview å‚ç…§)
    ! ã®ã‚ˆã†ã«ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ãŒå‡ºåŠ›ã•ã‚Œã¾ã™.
    ! å¿…ãš BeginSub ã¨åŒæ§˜ãªæ•°ã ã‘ EndSub ã‚’å‘¼ã¶ã‚ˆã†ã«ã—ã¦ãã ã•ã„.
    !
    ! ã¾ãŸ, æ–‡å—åž‹å¤‰æ•° *fmt* ãŠã‚ˆã³ãã‚Œä»¥é™ã®å¼•æ•°ã‚’ä¸Žãˆã‚‹äº‹ã§,
    ! ä»¥ä¸‹ã®ã‚ˆã†ã«ä»˜åŠ ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚‚å‡ºåŠ›å¯èƒ½ã§ã™. *fmt*
    ! ã¨ãã‚Œä»¥é™ã®å¼•æ•°ã«é–¢ã™ã‚‹æ›¸å¼ã¯ dc_string#CPrintf
    ! ã®èª¬æ˜Žã‚’å‚ç…§ã—ã¦ä¸‹ã•ã„.
    !
    !     # call name : fmt
    !
    ! åˆ©ç”¨ä¾‹ã«é–¢ã—ã¦ã¯ dc_trace ã® Usage ãŠã‚ˆã³ Example ã‚’å‚ç…§ã—ã¦ãã ã•ã„.
    !
    ! *version* ã«ã¯, å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ ã®ãƒãƒ¼ã‚¸ãƒ§ãƒ³ãƒŠãƒ³ãƒãƒ¼ã‚’ä¸Žãˆã¾ã™.
    ! *version* ã«ä¸Žãˆã‚‰ã‚ŒãŸæ–‡å—åˆ—ã¯, ã‚ã‚‹å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ
    ! ãŒè¤‡æ•°å›žå‘¼ã³å‡ºã•ã‚ŒãŸã†ã¡, åˆå›žã«å‘¼ã³å‡ºã•ã‚ŒãŸæ™‚ã®ã¿è¡¨ç¤ºã•ã‚Œã¾ã™.
    !
    !--
    !== é–‹ç™ºè€…å‘ã‘è§£èª¬
    !
    ! ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã«ã‚ˆã‚Š, ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«å†…ã§å†…éƒ¨çš„ã«ä¿æŒã•ã‚Œã‚‹
    ! æ•´æ•°åž‹å¤‰æ•° level ã®å€¤ãŒ 1 å¢—ãˆã¾ã™ã€‚
    !
    !++
    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
  subroutine EndSub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
    !
    !== å‰¯ãƒ—ãƒã‚°ãƒ©ãƒ çµ‚äº†ã®ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
    !
    ! æ–‡å—åž‹å¤‰æ•° name ã«ä¸ŽãˆãŸå‰¯ãƒ—ãƒã‚°ãƒ©ãƒ åã‚’ä»¥ä¸‹ã®ã‚ˆã†ã«å‡ºåŠ›ã—ã¾ã™ã€‚
    !
    !     # end name
    !
    ! BeginSub ã«å¯¾ã—ã¦ä¸€å¯¾ä¸€å¯¾å¿œã—ã¦ã„ã¾ã™ã®ã§ã€name ã«ã¯å¯¾å¿œã™ã‚‹
    ! BeginSub ã®å¼•æ•° name ã¨åŒã˜ã‚‚ã®ã‚’ä¸Žãˆã¦ä¸‹ã•ã„ã€‚
    !
    ! ã¾ãŸã€æ–‡å—åž‹å¤‰æ•° fmt ãŠã‚ˆã³ãã‚Œä»¥é™ã®å¼•æ•°ã‚’ä¸Žãˆã‚‹äº‹ã§ã€
    ! ä»¥ä¸‹ã®ã‚ˆã†ã«ä»˜åŠ ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚‚å‡ºåŠ›å¯èƒ½ã§ã™ã€‚ fmt
    ! ã¨ãã‚Œä»¥é™ã®å¼•æ•°ã«é–¢ã™ã‚‹æ›¸å¼ã¯ dc_string#CPrintf
    ! ã®èª¬æ˜Žã‚’å‚ç…§ã—ã¦ä¸‹ã•ã„ã€‚
    !
    !     # end name fmt
    !
    ! åˆ©ç”¨ä¾‹ã«é–¢ã—ã¦ã¯ dc_trace ã® Usage ãŠã‚ˆã³ Exampleã‚’å‚ç…§ã—ã¦ãã ã•ã„ã€‚
    !--
    !== é–‹ç™ºè€…å‘ã‘è§£èª¬
    !
    ! ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã«ã‚ˆã‚Š, ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«å†…ã§å†…éƒ¨çš„ã«ä¿æŒã•ã‚Œã‚‹
    ! æ•´æ•°åž‹å¤‰æ•° level ã®å€¤ãŒ 1 æ¸›ã‚Šã¾ã™ã€‚
    !
    !++
    use dc_types, only: STRING, 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
  subroutine DbgMessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
    !
    !== ãƒ‡ãƒãƒƒã‚°ç”¨ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸å‡ºåŠ›
    !
    ! ãƒ•ã‚©ãƒ¼ãƒžãƒƒãƒˆæ–‡å—åˆ— fmt ã«å¾“ã£ã¦ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã—ã¾ã™ã€‚
    ! fmt ã¨ãã‚Œä»¥é™ã®å¼•æ•°ã«é–¢ã™ã‚‹æ›¸å¼ã¯ dc_string#CPrintf
    ! ã®èª¬æ˜Žã‚’å‚ç…§ã—ã¦ä¸‹ã•ã„ã€‚
    !
    ! åˆ©ç”¨ä¾‹ã«é–¢ã—ã¦ã¯ dc_trace ã® Example ã‚’å‚ç…§ã—ã¦ä¸‹ã•ã„ã€‚
    !
    !--
    !== é–‹ç™ºè€…å‘ã‘è§£èª¬
    !
    ! ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’ç”¨ã„ã¦ã‚‚ã€ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«å†…ã§å†…éƒ¨çš„ã«ä¿æŒã•ã‚Œã‚‹
    ! æ•´æ•°åž‹å¤‰æ•° level ã®å€¤ã¯å¤‰åŒ–ã—ã¾ã›ã‚“ã€‚
    !
    !++
    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
  subroutine DataD1Dump(header, d, strlen, multi)
    !
    !== 1 æ¬¡å…ƒãƒ‡ãƒ¼ã‚¿å‡ºåŠ›
    !
    ! ãƒ‡ãƒãƒƒã‚°ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã¨ã—ã¦ã€å¤šæ¬¡å…ƒãƒ‡ãƒ¼ã‚¿ d (å€ç²¾åº¦å®Ÿæ•°åž‹)
    ! ã‚’å‡ºåŠ›ã—ã¾ã™ã€‚ æ–‡å—åž‹å¤‰æ•° header ã¯å‡ºåŠ›æ™‚ã®é æ–‡å—ã¨ã—ã¦åˆ©ç”¨ã•ã‚Œã¾ã™ã€‚
    ! æ•´æ•°åž‹é…åˆ— strlen ã‚’ä¸Žãˆã‚‹äº‹ã§ã€ä¸€è¡Œã®æ–‡å—æ•°ã‚’æŒ‡å®šã§ãã¾ã™
    ! (ãƒ‡ãƒ•ã‚©ãƒ«ãƒˆã®æ–‡å—æ•°ã¯ dc_types#STRING ã§æŒ‡å®šã•ã‚Œã¦ã„ã¾ã™)ã€‚
    ! æ•´æ•°åž‹é…åˆ— multi(:) ã‚’ä¸Žãˆã‚‹ã“ã¨ã§ã€
    ! header ã®å¾Œã‚ã«æ¬¡å…ƒæ·»å—ã‚’ã¤ã‘ã‚‹äº‹ãŒå¯èƒ½ã§ã™ã€‚
    !
    ! åˆ©ç”¨ä¾‹ã«é–¢ã—ã¦ã¯ dc_trace ã® Example ã‚’å‚ç…§ã—ã¦ä¸‹ã•ã„ã€‚
    !
    !--
    !== é–‹ç™ºè€…å‘ã‘è§£èª¬
    !
    ! ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’ç”¨ã„ã¦ã‚‚ã€ã“ã®ãƒ¢ã‚¸ãƒ¥ãƒ¼ãƒ«å†…ã§å†…éƒ¨çš„ã«ä¿æŒã•ã‚Œã‚‹
    ! æ•´æ•°åž‹å¤‰æ•° level ã®å€¤ã¯å¤‰åŒ–ã—ã¾ã›ã‚“ã€‚
    !
    !++
    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)
      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
  subroutine DataD2Dump(header, d, strlen, multi)
    !
    !== 2 æ¬¡å…ƒãƒ‡ãƒ¼ã‚¿å‡ºåŠ›
    !
    ! è©³ã—ãã¯ DataDump ã¾ãŸã¯ DataD1Dump ã‚’å‚ç…§ãã ã•ã„ã€‚
    !
    use dc_types,      only: STRING, 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
  subroutine DataD3Dump(header, d, strlen, multi)
    !
    !== 3 æ¬¡å…ƒãƒ‡ãƒ¼ã‚¿å‡ºåŠ›
    !
    ! è©³ã—ãã¯ DataDump ã¾ãŸã¯ DataD1Dump ã‚’å‚ç…§ãã ã•ã„ã€‚
    !
    use dc_types,      only: STRING, 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
  subroutine append(unit, ucur, val, stat, strlen)
    !
    ! DataD1Dump ã®å†…éƒ¨é–¢æ•°ã€‚
    ! unit ã« val ã‚’ä»˜åŠ ã€‚ãã®éš›ã€unit ãŒãã®æœ€å¤§æ–‡å—åˆ—é•·ã‚’è¶ŠãˆãŸå ´åˆ
    ! ã«ã¯ stat = 2 ã‚’è¿”ã™ã€‚
    !
    character(*), intent(inout):: unit ! æœ€çµ‚çš„ã«è¿”ã•ã‚Œã‚‹æ–‡å—åˆ—
    integer,      intent(inout):: ucur ! unit ã®æ–‡å—æ•°
    character(*), intent(in)   :: val  ! unit ã«ä»˜åŠ ã•ã‚Œã‚‹æ–‡å—åˆ—
    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
end module dc_trace