gtvarputline.f90

Go to the documentation of this file.

!> @file gtvarputline.f90
!>
!> @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 Print variable information
!>
!> This subroutine is provided as gtdata_generic#PutLine
!> through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 変数の印字
!>
!> このサブルーチンは gtdata_generic から gtdata_generic#PutLine
!> として提供されます。
!> @endja
 
!>
!> @en
!> @brief Print variable information
!>
!> Prints the information set in var.
!> By default, messages are output to standard output.
!> The output destination can be changed by specifying a unit number
!> with unit.
!> @param[in]  var    Variable handle
!> @param[in]  unit   Output unit number (optional, default: standard output)
!> @param[in]  indent Indent string for displayed messages (optional)
!> @param[out] err    Error flag (optional)
!> @enden
!>
!> @ja
!> @brief 変数情報の印字
!>
!> 引数 var に設定されている情報を印字します。
!> デフォルトではメッセージは標準出力に出力されます。
!> unit に装置番号を指定することで、出力先を変更することが可能です。
!> @param[in]  var    変数ハンドル
!> @param[in]  unit   出力先の装置番号 (省略可能、デフォルト: 標準出力)
!> @param[in]  indent 表示メッセージの字下げ (省略可能)
!> @param[out] err    エラーフラグ (省略可能)
!> @endja
!>
subroutine gtvarputline( var, unit, indent, err )
  use dc_types, only: string, stdout
  use gtdata_types, only: gt_variable
  use dc_error, only: errorcode, storeerror, dc_noerr, gt_enomem
  use dc_string, only: tochar, printf, putline
  use gtdata_generic, only: get, inquire
  use dc_trace, only: beginsub, endsub, dbgmessage
  implicit none
  type(gt_variable), intent(in):: var
  integer, intent(in), optional:: unit
  character(*), intent(in), optional:: indent
  logical, intent(out), optional:: err
  
  !-----------------------------------
  !  作業変数
  !  Work variables
  real, allocatable:: rvalue(:)
  integer:: siz, stat
!!$  integer:: i
  logical:: myerr
  integer:: out_unit
  integer:: indent_len
  character(STRING):: indent_str
  character(*), parameter:: subname = 'GTVarPutLine'
continue
  call beginsub(subname, '%d', i=(/var % mapid/))
  stat = dc_noerr
  !-----------------------------------------------------------------
  !  出力先装置番号と字下げの設定
  !  Configure output unit number and indents
  !-----------------------------------------------------------------
  if ( present(unit) ) then
    out_unit = unit
  else
    out_unit = stdout
  end if
 
  indent_len = 0
  indent_str = ''
  if ( present(indent) ) then
    if ( len(indent) /= 0 ) then
      indent_len = len(indent)
      indent_str(1:indent_len) = indent
    end if
  end if
 
  !-----------------------------------------------------------------
  !  初期設定されていない変数の印字
  !  Print uninitialized variables
  !-----------------------------------------------------------------
  if ( var % mapid < 0 ) then
    call printf( out_unit, &
      & indent_str(1:indent_len) // &
      & '#<GT_VARIABLE:: @initialized=%y>', &
      & l = (/.false./) )
    goto 999
  end if
 
  !-----------------------------------------------------------------
  !  初期設定されている変数の印字
  !  Print initialized variables
  !-----------------------------------------------------------------
  call inquire(var, size=siz)
  call dbgmessage('size = %d', i=(/siz/))
  stat = dc_noerr
  allocate(rvalue(siz), stat=stat)
  if (stat /= dc_noerr) then
    stat = gt_enomem
    goto 999
  endif
  call get(var, rvalue, size(rvalue), err=myerr)
  if (myerr) then
    stat = errorcode()
    if (stat /= dc_noerr) then
      call printf( out_unit, &
        & indent_str(1:indent_len) // &
        & '#<GT_VARIABLE:: @initialized=%y>', &
        & l = (/.false./) )
      stat = dc_noerr
    end if
    goto 999
  endif
  call printf( out_unit, &
    & indent_str(1:indent_len) // &
    & '#<GT_VARIABLE:: @initialized=%y', &
    & l = (/.true./) )
 
  call putline( rvalue, unit = out_unit, &
    & lbounds = lbound(rvalue), &
    & ubounds = ubound(rvalue), &
    & indent = indent_str(1:indent_len) // &
    & ' @value=' )
 
!!$  do, i = 1, size(rvalue)
!!$    call Printf(fmt='%r', r=(/rvalue(i)/))
!!$  end do
 
  call printf( out_unit, &
    & indent_str(1:indent_len) // &
    & '>' )
 
  deallocate(rvalue, stat=stat)
  if (stat /= dc_noerr) stat = gt_enomem
 
999 continue
  call storeerror(stat, subname, err)
  call endsub(subname, '%d stat=%d', i=(/var % mapid, stat/))
end subroutine gtvarputline