Class | dc_trace |
In: |
src/dc_trace.f90
|
name : | character(*), intent(in) |
fmt : | character(*), intent(in), optional |
i(:) : | integer, intent(in), optional |
r(:) : | real, intent(in), optional |
d(:) : | real(8), intent(in), optional |
L(:) : | logical, intent(in), optional |
s(:) : | type(VSTRING),intent(in), optional |
n(:) : | integer, intent(in), optional |
c1 : | character(*), intent(in), optional |
c2 : | character(*), intent(in), optional |
c3 : | character(*), intent(in), optional |
副プログラム開始のメッセージ出力 (level + 1)
subroutine BeginSub(name, fmt, i, r, d, L, s, n, c1, c2, c3) character(*), intent(in) :: name character(*), intent(in), optional:: fmt integer, intent(in), optional:: i(:), n(:) real, intent(in), optional:: r(:) real(8), intent(in), optional:: d(:) logical, intent(in), optional:: L(:) type(VSTRING),intent(in), optional:: s(:) character(*), intent(in), optional:: c1, c2, c3 character(string) :: cbuf continue if (lfirst) call initialize if (debug()) then if (present(fmt)) then cbuf = cprintf(fmt, i, r, d, L, s, n, c1, c2, c3) write(dbg, "(A, A, 'call ', A, ' : ', A)") trim(head), repeat(indent, level), trim(name), trim(cbuf) else write(dbg, "(A, A, 'call ',A)") trim(head), repeat(indent, level), trim(name) endif endif ! call errtra ! --- for Fujitsu debug if (level > size(table)) return level = level + 1 table(level) = name end subroutine BeginSub
header : | character(*), intent(in)
| ||
d(:) : | real(8), intent(in)
| ||
strlen : | integer, intent(in), optional
| ||
multi(:) : | integer, intent(in), optional
|
多次元データ出力 (level ± 0)
subroutine DataD1Dump(header, d, strlen, multi) character(*), intent(in) :: header ! データの名称 real(8), intent(in) :: d(:) ! 倍精度実数1次元データ 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 (.not. debug()) 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
header : | character(*), intent(in)
| ||
d(:,:,:) : | real(8), intent(in)
| ||
strlen : | integer, intent(in), optional
| ||
multi(:) : | integer, intent(in), optional
|
多次元データ出力 (level ± 0)
subroutine DataD3Dump(header, d, strlen, multi) character(*), intent(in) :: header ! データの名称 real(8), intent(in) :: d(:,:,:)! 倍精度実数3次元データ integer, intent(in), optional:: strlen ! 一行の文字数 integer, intent(in), optional:: multi(:)! 上位の次元添字 integer, allocatable :: total(:) integer :: k continue if (.not. debug()) 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
header : | character(*), intent(in)
| ||
d(:,:) : | real(8), intent(in)
| ||
strlen : | integer, intent(in), optional
| ||
multi(:) : | integer, intent(in), optional
|
多次元データ出力 (level ± 0)
subroutine DataD2Dump(header, d, strlen, multi) character(*), intent(in) :: header ! データの名称 real(8), intent(in) :: d(:,:) ! 倍精度実数2次元データ integer, intent(in), optional:: strlen ! 一行の文字数 integer, intent(in), optional:: multi(:)! 上位の次元添字 integer, allocatable :: total(:) integer :: j continue if (.not. debug()) 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