gtvarputline.f90

Path: gtvarputline.f90
Last Update: Wed Dec 19 19:34:31 JST 2007

変数の印字

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: gtvarputline.f90,v 1.6 2007/12/19 10:34:31 morikawa Exp $
Tag Name:$Name: gt4f90io-20080210 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は gtdata_generic から gtdata_generic#PutLine として提供されます。

Methods

Included Modules

dc_types gtdata_types dc_error dc_string gtdata_generic dc_trace

Public Instance methods

Subroutine :
var :type(GT_VARIABLE), intent(in)
unit :integer, intent(in), optional
: 出力先の装置番号. デフォルトの出力先は標準出力.

Unit number for output. Default value is standard output.

indent :character(*), intent(in), optional
: 表示されるメッセージの字下げ.

Indent of displayed messages.

err :logical, intent(out), optional
: 例外処理用フラグ. デフォルトでは, この手続き内でエラーが 生じた場合, プログラムは強制終了します. 引数 err が与えられる場合, プログラムは強制終了せず, 代わりに err に .true. が代入されます.

Exception handling flag. By default, when error occur in this procedure, the program aborts. If this err argument is given, .true. is substituted to err and the program does not abort.

引数 var に設定されている情報を印字します. デフォルトではメッセージは標準出力に出力されます. unit に装置番号を指定することで, 出力先を変更することが可能です.

Print information of var. By default messages are output to standard output. Unit number for output can be changed by unit argument.

[Source]

subroutine GTVarPutLine( var, unit, indent, err )
  !
  ! 引数 *var* に設定されている情報を印字します. 
  ! デフォルトではメッセージは標準出力に出力されます. 
  ! *unit* に装置番号を指定することで, 出力先を変更することが可能です. 
  !
  ! Print information of *var*. 
  ! By default messages are output to standard output. 
  ! Unit number for output can be changed by *unit* argument. 
  !
  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
                              ! 出力先の装置番号. 
                              ! デフォルトの出力先は標準出力. 
                              !
                              ! Unit number for output. 
                              ! Default value is standard output. 
  character(*), intent(in), optional:: indent
                              ! 表示されるメッセージの字下げ. 
                              !
                              ! Indent of displayed messages. 
  logical, intent(out), optional:: err
                              ! 例外処理用フラグ. 
                              ! デフォルトでは, この手続き内でエラーが
                              ! 生じた場合, プログラムは強制終了します. 
                              ! 引数 *err* が与えられる場合, 
                              ! プログラムは強制終了せず, 代わりに
                              ! *err* に .true. が代入されます. 
                              !
                              ! Exception handling flag. 
                              ! By default, when error occur in 
                              ! this procedure, the program aborts. 
                              ! If this *err* argument is given, 
                              ! .true. is substituted to *err* and 
                              ! the program does not abort. 
  
  !-----------------------------------
  !  作業変数
  !  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

[Validate]