hstnmlinfoputline.f90

Go to the documentation of this file.

!= GTHST_NMLINFO 型の変数に設定される情報の印字
!= Print information of "GTHST_NMLINFO"
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: hstnmlinfoputline.f90,v 1.2 2009-05-31 12:08:02 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2007-2009. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!
  subroutine hstnmlinfoputline( gthstnml, unit, indent, err )
    !
    ! 引数 *gthstnml* に設定されている情報を印字します. 
    ! デフォルトではメッセージは標準出力に出力されます. 
    ! *unit* に装置番号を指定することで, 出力先を変更することが可能です. 
    !
    ! Print information of *gthstnml*. 
    ! By default messages are output to standard output. 
    ! Unit number for output can be changed by *unit* argument. 
    !
    use gtool_history_nmlinfo_types, only: gthst_nmlinfo, gthst_nmlinfo_entry
    use gtool_history_nmlinfo_internal, only: listnext
    use gtool_history_generic, only: historyputline
    use dc_trace, only: beginsub, endsub
    use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
    use dc_types, only: dp, string, token, stdout
    use dc_error, only: storeerror, dc_noerr, dc_enotinit
    implicit none
    type(gthst_nmlinfo), intent(in):: gthstnml
    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
    type(gthst_nmlinfo_entry), pointer:: hptr =>null()
    integer:: stat
    character(STRING):: cause_c
    integer:: out_unit
    integer:: indent_len
    character(STRING):: indent_str
    character(*), parameter:: subname = 'HstNmlInfoPutLine'
  continue
    call beginsub( subname )
    stat = dc_noerr
    cause_c = ''

    !-----------------------------------------------------------------
    !  初期設定のチェック
    !  Check initialization
    !-----------------------------------------------------------------
    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

    !-----------------------------------------------------------------
    !  "GTHST_NMLINFO" の設定の印字
    !  Print the settings for "GTHST_NMLINFO"
    !-----------------------------------------------------------------
    if ( gthstnml % initialized ) then
      call printf( out_unit, &
        & indent_str(1:indent_len) // &
        & '#<GTHST_NMLINFO:: @initialized=%y define_mode=%y', &
        & l = (/gthstnml % initialized, gthstnml % define_mode/) )

      hptr => gthstnml % gthstnml_list

      do while ( associated( hptr ) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & ' #<GTHST_NMLINFO_ENTRY:: @name=%c @file=%c', &
          & c1 = trim(hptr % name), &
          & c2 = trim(hptr % file) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @interval_value=%r @interval_unit=%c', &
          & r = (/hptr % interval_value/), &
          & c1 = trim(hptr % interval_unit) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @output_step_disable=%y', &
          & l = (/hptr % output_step_disable/) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @precision=%c @time_average=%y', &
          & c1 = trim(hptr % precision), &
          & l = (/ hptr % time_average /) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @fileprefix=%c', &
          & c1 = trim(hptr % fileprefix) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @origin_value=%r @origin_unit=%c', &
          & r = (/hptr % origin_value/), &
          & c1 = trim(hptr % origin_unit) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @terminus_value=%r @terminus_unit=%c', &
          & r = (/hptr % terminus_value/), &
          & c1 = trim(hptr % terminus_unit) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @slice_start=%*d ...', &
          & i = (/hptr % slice_start(1:10)/), n = (/ 10 /) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @slice_end=%*d ...', &
          & i = (/hptr % slice_end(1:10)/), n = (/ 10 /) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @slice_stride=%*d ...', &
          & i = (/hptr % slice_stride(1:10)/), n = (/ 10 /) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @space_average=%*b ...', &
          & l = (/hptr % space_average(1:10)/), n =(/ 10 /) )

        call printf( out_unit, &
          & indent_str(1:indent_len) // &
          & '  @newfile_intvalue=%d @newfile_intunit=%c', &
          & i = (/hptr % newfile_intvalue/), &
          & c1 = trim(hptr % newfile_intunit) )

        if ( .not. gthstnml % define_mode ) then
          call printf( out_unit, &
            & indent_str(1:indent_len) // &
            & '  @history=' )

          call historyputline( hptr % history, &
            & unit = out_unit, &
            & indent = indent_str(1:indent_len) // &
            & '   ' )
        end if

        call listnext( gthstnml_list = hptr ) ! (inout)
      end do

      call printf( out_unit, &
        & indent_str(1:indent_len) // &
        & ' >' )

      call printf( out_unit, &
        & indent_str(1:indent_len) // &
        & '>' )
    else
      call printf( out_unit, &
        & indent_str(1:indent_len) // &
        & '#<GTHST_NMLINFO:: @initialized=%y>', &
        & l = (/gthstnml % initialized/) )
    end if

    !-----------------------------------------------------------------
    !  終了処理, 例外処理
    !  Termination and Exception handling
    !-----------------------------------------------------------------
999 continue
    call storeerror( stat, subname, err, cause_c )
    call endsub( subname )
  end subroutine hstnmlinfoputline