Class gt4_historyauto_h
In: gt4_historyauto_h.f90

gtool4 netCDF データの入出力インターフェース (堀之内バージョン)

Interface of Input/Output of gtool4 netCDF data (Horinouchi version)

module gt4_history のアプリケーション. 変数毎に時・空間に自由にサンプリングを設定できる. 長くなりそうな出力の時分割や並列化に対応.

その他の特徴

  • 一つの変数を切り方や時間間隔を変えて複数出すこともできる.
  • 並列化対応は, 単にプロセス固有のサフィックスをファイル名に付けられる だけという単純なものである. MPI などを使う際に, 各ノードが自分の 受け持ちの領域をそれぞれ独立なファイルに出すことを想定している.
  • 時間積分ループ内でデータを出力するためのコーディングを楽にする工夫
    • 出力する変数に関する諸々の情報はモジュール内部に取っておき, 外部からは名前で指定する. 生の gt4f90io の場合, 出力初期化でできた GT_HISTORY 構造体を実際の出力場所に渡さなければない. そうすると 時間積分のループの内と外をどうやって繋ぐかという悩みが発生するが, ここではその悩みから解放される.
    • 出力するタイミングも内部で管理されるため時間積分ループ内で毎回出力 命令を呼んで構わない. なお, 出力のためだけに特別に計算する物理量を 無駄に計算しないための工夫もある (関数 HistoryAutoWhetherPutNow)
  • 地図投影座標のように, 多次元の座標 (補助) 変数を出力したい場合も考慮さ れている (HistoryAutoCreate のオプション引数 ancilcrdvars).
  • 任意の属性が簡単に追加できる (HistoryAutoCreate のオプション引数 attrs).

Procedures List

HistoryAutoCreate :.
HistoryAutoCopyCreate :.
HistoryAutoPut :.
HistoryAutoWhetherPutNow :.

Derived types List (and constructors)

GT4_ATTRIBUTE ( init_gt4_attribute ) :.
GT4_REAL1D ( init_gt4_real1d ) :.
GT4_NAMED_REALARY ( init_gt4_named_realary ) :.

History

  • 2004/11/??-19 堀之内 武 作成
  • 2005/02/17 堀之内 武 ドキュメントちょこっと修正

ToDo

  • 長さ (*) の配列は本当に必要か? 実は (:) にしたいんだけど, 長さチェック実装を面倒がって当座 (*) にしたんでは?? もしそれだけの問題なら, 長さチェックをするようにして, まずければ 例外が発生するようにすべき.
  • 現在は内部データの保持は単なる linked list を使っているが, 登録変数が多くても高速に検索できるようにするため, 2 分探索出来る ように変えるべき.

Methods

Included Modules

dc_types dc_trace dc_present gt4_history dc_error

Public Instance methods

GT4_ATTRIBUTE
Derived Type :
name :character(len=TOKEN)
rval(:) =>null() :real,pointer
ival(:) =>null() :integer,pointer
cval :character(len=STRING)

属性を名前と値の組で入れる

GT4_NAMED_REALARY
Derived Type :
rank :integer
name :character(len=TOKEN)
dims(3) :character(len=TOKEN)
: to support up to 3D
longname :character(len=STRING)
units :character(len=STRING)
ary(:) =>null() :real,pointer

名前, 次元名, longname, units を持つ実数配列. 配列データは 1 次元で保持

GT4_REAL1D
Derived Type :
ary(:) => null() :real,pointer

to make an array of 1D arrays

配列の配列をつくるための型 (実数)

Subroutine :
name :character(len=*), intent(in)
longname :character(len=*), intent(in)
units :character(len=*), intent(in)
file :character(len=*), intent(in),optional

use the result of the latest call of HistoryAutoCreate

直前の HistoryAutoCreate を使って, 格子及び出力の空間・時間 サンプリングが同じ出力を定義する. file を省略すれば 同じファイルを使う.

[Source]

  subroutine HistoryAutoCopyCreate( name, longname, units, file )
    !
    ! use the result of the latest call of HistoryAutoCreate
    !
    ! 直前の HistoryAutoCreate を使って, 格子及び出力の空間・時間
    ! サンプリングが同じ出力を定義する. file を省略すれば
    ! 同じファイルを使う.
    !
    character(len=*), intent(in)          :: name
    character(len=*), intent(in)          :: longname
    character(len=*), intent(in)          :: units
    character(len=*), intent(in),optional :: file
    !
    type(HIST_EACHVAR)              :: hist
    type(HIST_EACHVAR),pointer      :: histpt
    character(len = *), parameter:: subname = 'HistoryAutoCopyCreate'
    !
    call BeginSub(subname)
    histpt => histpl_last(HISTPOOL)
    hist = histpt         ! copy the contents
    if(present_and_not_empty(file)) then
      hist%file = file
      allocate(hist%h)       ! always new allocation
      nullify(hist%h%hs)
    else
      hist%h => histpt%h
    endif
    hist%name = name
    hist%longname = longname
    hist%units = units
    call histpl_push(HISTPOOL, hist)
    call EndSub(subname)
  end subroutine HistoryAutoCopyCreate
Subroutine :
name :character(len=*), intent(in)
longname :character(len=*), intent(in)
units :character(len=*), intent(in)
file :character(len=*), intent(in)
slfst(*) :integer, intent(in)
: size == sprank 空間データのスライス (開始点の指定. 指定はデータの値ではなく, 格子点添字)
sllst(*) :integer, intent(in)
: size == sprank 空間データのスライス (終了点の指定. 指定はデータの値ではなく, 格子点添字). 0 を指定する場合には, データの最後尾を 終了点とする.
slstp(*) :integer, intent(in)
: size == sprank 空間データのスライス (刻み幅の指定. 指定はデータの値ではなく, 格子点添字).
time_to_start :real, intent(in)
: 出力開始時刻
put_interval :real, intent(in)
: データ出力間隔
dt :real, intent(in)
: モデルのΔt (時刻を自動で進めるためではなく, 時刻の許容誤差を測るためのもの).
newfile_interval :real, intent(in)
: ファイルを分割する時間間隔. 負の値を与えると分割を行わない.
attrs(:) :type(GT4_ATTRIBUTE),intent(in),optional
aryshape(:) :integer, intent(in)
: size <= 3 (—> sprank) 次元サイズの指定
dims(*) :character(len=*), intent(in)
: size == sprank+1
axlongnames(*) :character(len=*), intent(in)
: size == sprank+1
axunits(*) :character(len=*), intent(in)
: size == sprank+1
axxtypes(*) :character(len=*), intent(in)
spcoordvars(*) :type(GT4_REAL1D), intent(in)
: size == sprank
ancilcrdvars(:) :type(GT4_NAMED_REALARY),intent(in),optional
title :character(len=*), intent(in),optional
source :character(len=*), intent(in),optional
institution :character(len=*), intent(in),optional
conventions :character(len=*), intent(in),optional
gt_version :character(len=*), intent(in),optional
proc :character(len=*), intent(in),optional
domain_div :logical, intent(in),optional
subdomfst(*) :integer, intent(in),optional
: For domain-dividing comp. first indx relative in the whole dom. (size == sprank)

ヒストリファイル初期化情報の設定. 実際のファイル初期化は 必要に応じて HistoryAutoPut が行う (時分割するときは適宜 クローズと初期化を繰り返さないとならないので, そういう 構造になる). なお, 一つのファイルへの出力に対して このサブルーチンを 2 回以上呼んではならない. 複数の 変数を一つのファイルに出したい場合は, HistoryAutoCopyCreate を利用せよ. 時・空間に自由にサンプリングを設定できる. 但し, いずれも等間隔. 長い時間積分によって, ファイルが 大きくなり過ぎることに対応するため, 一定の時間間隔で 分割することが可能. また, 並列化を念頭に各ノードを特定する 文字列を挿入することができる.

[Source]

  subroutine HistoryAutoCreateH1( name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, aryshape, dims, axlongnames, axunits, axxtypes, spcoordvars, ancilcrdvars, title, source, institution, conventions, gt_version, proc, domain_div, subdomfst )
    !
    ! ヒストリファイル初期化情報の設定. 実際のファイル初期化は
    ! 必要に応じて HistoryAutoPut が行う (時分割するときは適宜
    ! クローズと初期化を繰り返さないとならないので, そういう
    ! 構造になる). なお, 一つのファイルへの出力に対して
    ! このサブルーチンを 2 回以上呼んではならない. 複数の
    ! 変数を一つのファイルに出したい場合は, HistoryAutoCopyCreate
    ! を利用せよ.
    ! 時・空間に自由にサンプリングを設定できる.
    ! 但し, いずれも等間隔. 長い時間積分によって, ファイルが
    ! 大きくなり過ぎることに対応するため, 一定の時間間隔で
    ! 分割することが可能. また, 並列化を念頭に各ノードを特定する
    ! 文字列を挿入することができる.
    !
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: name
    character(len=*), intent(in)     :: longname
    character(len=*), intent(in)     :: units
    character(len=*), intent(in)     :: file
    integer, intent(in)              :: slfst(*)     ! size == sprank
                              ! 空間データのスライス (開始点の指定. 
                              ! 指定はデータの値ではなく, 格子点添字)
    integer, intent(in)              :: sllst(*)     ! size == sprank
                              ! 空間データのスライス (終了点の指定. 
                              ! 指定はデータの値ではなく, 格子点添字). 
                              ! 0 を指定する場合には, データの最後尾を
                              ! 終了点とする. 
    integer, intent(in)              :: slstp(*)     ! size == sprank
                              ! 空間データのスライス (刻み幅の指定. 
                              ! 指定はデータの値ではなく, 格子点添字). 
    real,             intent(in)     :: time_to_start
                              ! 出力開始時刻
    real,             intent(in)     :: put_interval
                              ! データ出力間隔
    real,             intent(in)     :: dt
                              ! モデルのΔt (時刻を自動で進めるためではなく, 
                              ! 時刻の許容誤差を測るためのもの). 
    real, intent(in)                 :: newfile_interval
                              ! ファイルを分割する時間間隔. 
                              ! 負の値を与えると分割を行わない. 
    type(GT4_ATTRIBUTE),intent(in),optional  :: attrs(:)
    integer, intent(in)              :: aryshape(:) ! size <= 3 (--> sprank)
                              ! 次元サイズの指定
    character(len=*), intent(in)     :: dims(*)           !size == sprank+1
    character(len=*), intent(in)     :: axlongnames(*)    !size == sprank+1
    character(len=*), intent(in)     :: axunits(*)        !size == sprank+1
    character(len=*), intent(in)     :: axxtypes(*)
    type(GT4_REAL1D), intent(in)         :: spcoordvars(*)    ! size == sprank
    type(GT4_NAMED_REALARY),intent(in),optional  :: ancilcrdvars(:)
    character(len=*), intent(in),optional  :: proc
    character(len=*), intent(in),optional  :: title, source, institution
    character(len=*), intent(in),optional  :: conventions, gt_version
    logical, intent(in),optional :: domain_div
    integer, intent(in),optional :: subdomfst(*) ! For domain-dividing comp.
    ! first indx relative in the whole dom. (size == sprank)
    !
    type(HIST_EACHVAR)            :: hist
    integer                       :: sprank,i,slf
    character(len = *),parameter  :: subname = "HistoryAutoCreate1"
    
    call BeginSub(subname)
    
    !< initialize hist except hist%h -- actual creation is deferred >
    
    hist%time_last = -1e35 ! time_last_inival
    allocate(hist%h)       ! always new allocation
    nullify(hist%h%hs)
    
    hist%name = name
    hist%longname = longname
    hist%units = units
    
    sprank = min( size(aryshape), 3 )
    hist%sprank = sprank
    
    
    if ( present_and_true(domain_div) ) then
      hist%domain_div = .true.
      if (.not. present(subdomfst)) call StoreError(USR_ERRNO, subname, cause_c='When domain_div is present and true, subdomfst '// 'must also be present.')
    else
      hist%domain_div = .false.
    end if
    
    if (hist%domain_div .and. (minval(slfst(1:sprank)).le.0 .or. minval(sllst(1:sprank)).lt.0) ) then
      call StoreError(USR_ERRNO, subname, cause_c='When the domain is divided, output-domain '// 'limiting from the end by using negative indices is not '// 'available, since the whole domain size is not known. '// 'Use a postive number (or zero for sllst to express the'// ' last grid point).')
    endif
    
    hist%size = 1
    hist%out_of_domain = .false.   ! Init. May be true in domain division.
    
    do i=1,sprank
      hist%aryshape(i) = aryshape(i)
      if(slstp(i) > 0) then
        hist%slstp(i) = slstp(i)
      else
        hist%slstp(i) = 1
      endif
      if (.not.hist%domain_div) then
        if(slfst(i) > 0) then
          hist%slfst(i) = slfst(i)
        else
          hist%slfst(i) = slfst(i) + aryshape(i)
        endif
        if(sllst(i) > 0) then
          hist%sllst(i) = sllst(i)
        else
          hist%sllst(i) = sllst(i) + aryshape(i)
        endif
      else
        slf = slfst(i) - subdomfst(i) + 1
        if (slf.le.0) then
          slf = modulo(slf-1,hist%slstp(i)) + 1
        else if(slf.gt.aryshape(i)) then
          hist%out_of_domain = .true.
        endif
        hist%slfst(i) = slf
        if (sllst(i).eq.0) then
          hist%sllst(i) = aryshape(i)
        else
          hist%sllst(i) = min( sllst(i) - subdomfst(i) + 1, aryshape(i) )
          if (hist%sllst(i).le.0) then
            hist%out_of_domain = .true.
          endif
        endif
      endif
      hist%dimsizes(i) = (hist%sllst(i)-hist%slfst(i))/hist%slstp(i) + 1
      if (.not.hist%domain_div) then
        if (hist%slfst(i)<=0 .or. hist%slfst(i)>aryshape(i)) call StoreError(USR_ERRNO, subname, cause_c= 'str not within the index range for dim:',cause_i=i)
        if (hist%sllst(i)<=0 .or. hist%sllst(i)>aryshape(i)) call StoreError(USR_ERRNO, subname, cause_c= 'end not within the index range for dim:',cause_i=i)
        if (hist%slstp(i)<=0) call StoreError(USR_ERRNO, subname, cause_c='step not positive for dim:', cause_i=i)
        if (hist%dimsizes(i)<=0) call StoreError(USR_ERRNO, subname, cause_c='negative dimsize for dim:', cause_i=i)
      endif
      hist%size = hist%size * hist%dimsizes(i)
    enddo
    hist%dimsizes(sprank+1) = 0   ! unlimited dimension
    
    hist%file = file
    hist%newfile_interval = newfile_interval
    hist%dims(1:sprank+1) = dims(1:sprank+1)
    hist%axlongnames(1:sprank+1) = axlongnames(1:sprank+1)
    hist%axunits(1:sprank+1) = axunits(1:sprank+1)
    hist%time_to_start = time_to_start
    hist%put_interval = put_interval
    hist%dt = dt
    hist%axxtypes(1:sprank+1) = axxtypes(1:sprank+1)
    if(present(title)) then
      hist%title = title
    else
      hist%title = com_title
    endif
    if(present(source)) then
      hist%source = source
    else
      hist%source = com_source
    endif
    if(present(institution)) then
      hist%institution = institution
    else
      hist%institution = com_institution
    endif
    if(present(conventions)) then
      hist%conventions = conventions
    else
      hist%conventions = com_conventions
    endif
    if(present(gt_version)) then
      hist%gt_version = gt_version
    else
      hist%gt_version = com_gt_version
    endif
    if(present(proc)) then
      hist%proc = proc
    else
      hist%proc = com_proc
    endif
    
    hist%spcoordvars(1:sprank) = spcoordvars(1:sprank)
    if(.not. present(ancilcrdvars)) then
      nullify(hist%ancilcrdvars)
    else if ( size(ancilcrdvars)==0 )then
      nullify(hist%ancilcrdvars)
    else
      allocate(hist%ancilcrdvars(size(ancilcrdvars))) ! always new alloc
      hist%ancilcrdvars = ancilcrdvars
    endif
    
    if(.not. present(attrs)) then
      nullify(hist%attrs)
    else if ( size(attrs)==0 )then
      nullify(hist%attrs)
    else
      allocate(hist%attrs(size(attrs))) ! always new alloc
      hist%attrs = attrs
    endif
    
    call histpl_push(HISTPOOL, hist)
    
    call EndSub(subname)
  end subroutine HistoryAutoCreateH1
Subroutine :
name :character(len=*), intent(in)
longname :character(len=*), intent(in)
units :character(len=*), intent(in)
file :character(len=*), intent(in)
slfst(*) :integer, intent(in)
: size == sprank
sllst(*) :integer, intent(in)
: size == sprank
slstp(*) :integer, intent(in)
: size == sprank
time_to_start :real, intent(in)
put_interval :real, intent(in)
dt :real, intent(in)
newfile_interval :real, intent(in)
attrs(:) :type(GT4_ATTRIBUTE),intent(in),optional
grid_label :character(len=*), intent(in)
: <— HistoryAutoSetGrid
title :character(len=*), intent(in),optional
source :character(len=*), intent(in),optional
institution :character(len=*), intent(in),optional
conventions :character(len=*), intent(in),optional
gt_version :character(len=*), intent(in),optional
proc :character(len=*), intent(in),optional

[Source]

  subroutine HistoryAutoCreateH2( name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, grid_label, title, source, institution, conventions, gt_version, proc )
    use dc_error, only: USR_ERRNO, USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: name
    character(len=*), intent(in)     :: longname
    character(len=*), intent(in)     :: units
    character(len=*), intent(in)     :: file
    integer, intent(in)              :: slfst(*)     ! size == sprank
    integer, intent(in)              :: sllst(*)     ! size == sprank
    integer, intent(in)              :: slstp(*)     ! size == sprank
    real,             intent(in)     :: time_to_start, put_interval, dt
    real, intent(in)                 :: newfile_interval
    type(GT4_ATTRIBUTE),intent(in),optional  :: attrs(:)
    character(len=*), intent(in)     :: grid_label  ! <-- HistoryAutoSetGrid
    character(len=*), intent(in),optional  :: proc
    character(len=*), intent(in),optional  :: title, source, institution
    character(len=*), intent(in),optional  :: conventions, gt_version
    !
    type(HIST_EACHVAR),pointer    :: hist
    integer                       :: ith
    character(len = *),parameter  :: subname = "HistoryAutoCreate2"
    
    call BeginSub(subname)
    ith = 1
    if (.not.histpl_find(HISTGRIDPOOL, grid_label, ith, hist)) then
      call StoreError(USR_ERRNO, subname, cause_c='grid '//trim(subname)//' not found')
    endif
    
    call HistoryAutoCreate1( name, longname, units, file, slfst, sllst, slstp, time_to_start, put_interval, dt, newfile_interval, attrs, hist%aryshape(1:hist%sprank), hist%dims(1:hist%sprank+1), hist%axlongnames(1:hist%sprank+1), hist%axunits(1:hist%sprank+1), hist%axxtypes(1:hist%sprank+1), hist%spcoordvars, hist%ancilcrdvars, title, source, institution, conventions, gt_version, proc, hist%domain_div, hist%subdomfst )
    
    call EndSub(subname)
  end subroutine HistoryAutoCreateH2
Subroutine :
name :character(len=*), intent(in)
vals(*) :real
time :real

変数の出力を行う. タイミングは内部で制御するので, 全タイム ステップで呼べば良い. なお, 下記の HistoryAutoWhetherPutNow を使って呼ぶタイミングを制御しても良い.

[Source]

  subroutine HistoryAutoPutH0(name, vals, time)
    !
    ! 変数の出力を行う. タイミングは内部で制御するので, 全タイム
    ! ステップで呼べば良い. なお, 下記の HistoryAutoWhetherPutNow
    ! を使って呼ぶタイミングを制御しても良い.
    !
    implicit none
    character(len=*), intent(in)     :: name
    real                             :: vals(*)
    real                             :: time
    !
    type(HIST_EACHVAR),pointer      :: hst
    integer                         :: ith, j, rank
    character(len=STRING)           :: file_actual
    real                            :: eps=3e-7, newest
    type(GT_HISTORY),pointer        :: hist
    logical                         :: put_now
    integer                         :: arysize
    real,pointer                    :: subset(:)
    character(len = *), parameter:: subname = 'HistoryAutoPut'
    !
    call BeginSub(subname, 'name=<%c>, time=<%r>', c1=trim(name), r=(/time/))
    ith = 1
    do while( histpl_find(HISTPOOL, name, ith, hst) )
      put_now = whether_to_put_now( time, hst%time_last, hst%time_to_start, hst%put_interval, hst%dt )
      if ( put_now .and. .not.hst%out_of_domain ) then
        if ( associated(hst%h%hs) ) then
          call HistoryInquire(hst%h%hs, newest=newest)
          if ( hst%newfile_interval > 0 .and. time >= hst%time_to_start+hst%newfile_interval*(1.0-eps) .and. newest < time) then
            ! to make a new file
            hst%time_to_start = hst%time_to_start + hst%newfile_interval
            call HistoryClose(hst%h%hs)
            nullify(hst%h%hs)
          endif
        endif
        if (.not.associated(hst%h%hs)) then
          if (hst%newfile_interval > 0) then
            file_actual = merge_file_proc_time(hst%file,hst%proc, hst%time_to_start)
          else
            file_actual = merge_file_proc_time(hst%file,hst%proc)
          endif
          rank = hst%sprank + 1
          allocate(hist)   ! always new allocataion
          call HistoryCreate( file_actual, trim(hst%title), trim(hst%source), trim(hst%institution), hst%dims(1:rank), hst%dimsizes(1:rank), hst%axlongnames(1:rank), hst%axunits(1:rank), hst%time_to_start, hst%put_interval, hst%axxtypes(1:rank), hist, trim(hst%conventions),  trim(hst%gt_version))
          hst%h%hs => hist
          call HistoryAddVariable(name, hst%dims(1:rank), trim(hst%longname), trim(hst%units), history=hst%h%hs)
          if (associated(hst%attrs)) then
            do j=1,size(hst%attrs)
              call add_gt4_attribute(hst, hst%attrs(j))
            enddo
          endif
          if (associated(hst%ancilcrdvars)) then
            do j=1,size(hst%ancilcrdvars)
              call add_ancilcrdvar(hst, hst%ancilcrdvars(j))
            enddo
          endif
          do j=1,hst%sprank
            subset => make_slice(hst%spcoordvars(j)%ary, 1, (/hst%aryshape(j)/), (/hst%slfst(j)/), (/hst%sllst(j)/), (/hst%slstp(j)/) )
            if (associated(subset)) then
              call HistoryPut(hst%dims(j), subset, hst%h%hs)
            else
              call HistoryPut(hst%dims(j), hst%spcoordvars(j)%ary, hst%h%hs)
            endif
          enddo
          if (associated(hst%ancilcrdvars)) then
            do j=1,size(hst%ancilcrdvars)
              call put_ancilcrdvar(hst, hst%ancilcrdvars(j))
            enddo
          endif
          
          call HistorySetTime(time, hst%h%hs)
        else
          rank = hst%sprank + 1
          if ( .not. HistoryHasVariable(hst%h%hs, name) ) then
            call HistoryAddVariable(name, hst%dims(1:rank), trim(hst%longname), trim(hst%units), history=hst%h%hs)
            !" ここで HistorySetTime すると問題が起きるので前回に従う
            if (associated(hst%attrs)) then
              do j=1,size(hst%attrs)
                call add_gt4_attribute(hst, hst%attrs(j))
              enddo
            endif
          else
            call HistorySetTime(time, hst%h%hs)
          endif
        endif
        
        arysize = product(hst%aryshape(1:hst%sprank))
        subset => make_slice(vals(1:arysize), hst%sprank, (/hst%aryshape/), (/hst%slfst/), (/hst%sllst/), (/hst%slstp/))
        if (associated(subset)) then
          call HistoryPut(name, subset, hst%h%hs)
        else
          call HistoryPut(name, vals(1:hst%size), hst%h%hs)
        endif
        hst%time_last = time
        
      endif
    enddo
    call EndSub(subname)
  end subroutine HistoryAutoPutH0
Subroutine :
grid_label :character(len=*), intent(in)
aryshape(:) :integer, intent(in)
: size <= 3 (—> sprank)
dims(:) :character(len=*), intent(in)
: size == sprank+1
axlongnames(:) :character(len=*), intent(in)
: size == sprank+1
axunits(:) :character(len=*), intent(in)
: size == sprank+1
axxtypes(:) :character(len=*), intent(in)
coord1(:) :real, intent(in),optional
: must present if sprank>=1
coord2(:) :real, intent(in),optional
: must present if sprank>=2
coord3(:) :real, intent(in),optional
: must present if sprank>=3
ancilcrdvars(:) :type(GT4_NAMED_REALARY),intent(in),optional
subdomfst(:) :integer, intent(in),optional
: For domain-dividing comp. first indx relative in the whole dom. (size == sprank)

[Source]

  subroutine HistoryAutoSetGrid( grid_label, aryshape, dims, axlongnames, axunits, axxtypes, coord1, coord2, coord3, ancilcrdvars, subdomfst )
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in)     :: grid_label
    integer, intent(in)              :: aryshape(:) ! size <= 3 (--> sprank)
    character(len=*), intent(in)     :: dims(:)           !size == sprank+1
    character(len=*), intent(in)     :: axlongnames(:)    !size == sprank+1
    character(len=*), intent(in)     :: axunits(:)        !size == sprank+1
    character(len=*), intent(in)     :: axxtypes(:)
    real, intent(in),optional        :: coord1(:) ! must present if sprank>=1
    real, intent(in),optional        :: coord2(:) ! must present if sprank>=2
    real, intent(in),optional        :: coord3(:) ! must present if sprank>=3
    type(GT4_NAMED_REALARY),intent(in),optional  :: ancilcrdvars(:)
    integer, intent(in),optional :: subdomfst(:) ! For domain-dividing comp.
    ! first indx relative in the whole dom. (size == sprank)
    !
    type(HIST_EACHVAR)            :: hist
    integer                       :: sprank
    character(len = *),parameter  :: subname = "HistoryAutoSetGrid"
    continue
    call BeginSub(subname)
    
    sprank = min( size(aryshape), 3 )
    
    hist%sprank = sprank
    hist%name = grid_label
    hist%aryshape(1:sprank) = aryshape(1:sprank)
    hist%dims(1:sprank+1) = dims(1:sprank+1)
    hist%axlongnames(1:sprank+1) = axlongnames(1:sprank+1)
    hist%axunits(1:sprank+1) = axunits(1:sprank+1)
    hist%axxtypes(1:sprank+1) = axxtypes(1:sprank+1)
    if (present(subdomfst)) then
      hist%domain_div = .true.
      hist%subdomfst(1:sprank) = subdomfst(1:sprank)
    else
      hist%domain_div = .false.
    endif
    
    if (sprank >= 1) hist%spcoordvars(1) = init_gt4_real1d( coord1 )
    if (sprank >= 2) hist%spcoordvars(2) = init_gt4_real1d( coord2 )
    if (sprank >= 3) hist%spcoordvars(3) = init_gt4_real1d( coord3 )
    
    if(.not. present(ancilcrdvars)) then
      nullify(hist%ancilcrdvars)
    else if ( size(ancilcrdvars)==0 )then
      nullify(hist%ancilcrdvars)
    else
      allocate(hist%ancilcrdvars(size(ancilcrdvars))) ! always new alloc
      hist%ancilcrdvars = ancilcrdvars
    endif
    
    call histpl_push(HISTGRIDPOOL, hist)
    call EndSub(subname)
  end subroutine HistoryAutoSetGrid
Subroutine :
title :character(len=*), intent(in), optional
source :character(len=*), intent(in), optional
institution :character(len=*), intent(in), optional
proc :character(len=*), intent(in), optional
conventions :character(len=*), intent(in), optional
gt_version :character(len=*), intent(in), optional

[Source]

  subroutine HistoryAutoSetRunInfo( title, source, institution, proc, conventions, gt_version  )
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    character(len=*), intent(in), optional     :: title, source, institution
    character(len=*), intent(in), optional     :: proc
    character(len=*), intent(in), optional     :: conventions, gt_version
    !
    character(len = *),parameter  :: subname = "HistoryAutoSetRunInfo"
    continue
    call BeginSub(subname)
    
    if (present(title)) com_title = title
    if (present(source)) com_source = source
    if (present(institution)) com_institution = institution
    if (present(proc)) com_proc = proc
    if (present(conventions)) com_conventions = conventions
    if (present(gt_version)) com_gt_version = gt_version
    
    call EndSub(subname)
  end subroutine HistoryAutoSetRunInfo
Function :
result :logical
name :character(len=*), intent(in)
time :real, intent(in)

name の名を持つ出力項目に関し, 現在がファイルに出力するタイミ ングかどうかを返す. 同名で複数の出力をする場合, どれか一つでも 出力するタイミングなら .true. を返す. 出力のために特別に計算を を要するようなケースに使うと良い. (ほとんどのステップで無駄に なる計算をするのを避けられる)

[Source]

  function HistoryAutoWhetherPutNow( name, time ) result(result)
    !
    ! name の名を持つ出力項目に関し, 現在がファイルに出力するタイミ
    ! ングかどうかを返す. 同名で複数の出力をする場合, どれか一つでも
    ! 出力するタイミングなら .true. を返す. 出力のために特別に計算を
    ! を要するようなケースに使うと良い. (ほとんどのステップで無駄に
    ! なる計算をするのを避けられる)
    !
    implicit none
    logical                         :: result
    character(len=*), intent(in)    :: name
    real, intent(in)                :: time
    !
    integer                      :: ith
    type(HIST_EACHVAR),pointer   :: hst
    character(len = *), parameter:: subname = 'HistoryAutoWhetherPutNow'
    logical                      :: put_now
    !
    call BeginSub(subname)
    result = .false.
    ith = 1
    do while( histpl_find(HISTPOOL, name, ith, hst) )
      put_now = whether_to_put_now( time, hst%time_last, hst%time_to_start, hst%put_interval, hst%dt )
      if (put_now) then
        result = .true.
        exit
      endif
    enddo
    call EndSub(subname)
  end function HistoryAutoWhetherPutNow
Function :
result :type(GT4_ATTRIBUTE)
name :character(len=*),intent(in)
rval(:) :real,intent(in),optional
ival(:) :integer,intent(in),optional
cval :character(len=*),intent(in),optional

ATTRIBUTEのコンストラクター. 名前 & (実数配列 or 整数配列 or 文字列) を与える

[Source]

  function init_gt4_attribute(name,rval,ival,cval) result(result)
    !
    ! ATTRIBUTEのコンストラクター. 
    ! 名前 & (実数配列 or 整数配列 or 文字列) を与える
    !
    implicit none
    type(GT4_ATTRIBUTE)                       :: result
    character(len=*),intent(in)           :: name
    real,intent(in),optional              :: rval(:)
    integer,intent(in),optional           :: ival(:)
    character(len=*),intent(in),optional  :: cval
    result%name = name
    if(present(rval)) then
      allocate(result%rval(size(rval)))
      result%rval = rval
      nullify(result%ival)
    else if (present(ival)) then
      allocate(result%ival(size(ival)))
      result%ival = ival
      nullify(result%rval)
    else if (present(cval)) then
      nullify(result%rval)
      nullify(result%ival)
      result%cval = cval
    endif
  end function init_gt4_attribute
Function :
result :type(GT4_NAMED_REALARY)
name :character(len=*),intent(in)
rank :integer,intent(in)
dims(rank) :character(len = *),intent(in)
length :integer,intent(in)
ary(length) :real,intent(in)
longname :character(len=*),intent(in)
units :character(len=*),intent(in)

GT4_NAMED_REALARYのコンストラクター.

[Source]

  function init_gt4_named_realary(name,rank,dims,length,ary,longname,units) result(result)
    ! GT4_NAMED_REALARYのコンストラクター. 
    use dc_error, only: USR_ERRNO, StoreError
    implicit none
    type(GT4_NAMED_REALARY)            :: result
    !
    character(len=*),intent(in)    :: name
    integer,intent(in)             :: rank
    character(len = *),intent(in)  :: dims(rank)
    integer,intent(in)             :: length
    real,intent(in)                :: ary(length)
    character(len=*),intent(in)    :: longname
    character(len=*),intent(in)    :: units
    !
    character(len = *), parameter:: subname = 'init_gt4_named_realary'
    !
    call BeginSub(subname)
    if(rank>3 .or. rank<0) call StoreError(USR_ERRNO, subname, cause_c='rank must be <= 3 and >=1')
    result%rank = rank
    result%name = name
    result%dims(1:rank) = dims(1:rank)
    allocate(result%ary(length))     ! always new allocation
    result%ary(1:length) = ary(1:length)
    result%longname = longname
    result%units = units
    call EndSub(subname)
  end function init_gt4_named_realary
Function :
result :type(GT4_REAL1D)
ary(:) :real,intent(in)

REAL1Dのコンストラクター.

[Source]

  function init_gt4_real1d(ary) result(result)
    !
    ! REAL1Dのコンストラクター. 
    !
    implicit none
    type(GT4_REAL1D)      :: result
    real,intent(in)   :: ary(:)
    if(associated(result%ary)) deallocate(result%ary)
    allocate(result%ary(size(ary)))
    result%ary = ary
  end function init_gt4_real1d

[Validate]