!= gt4_history_nmlinfo モジュールのテストプログラム ! != Test program for "gt4_history_nmlinfo" ! ! Authors:: Yasuhiro MORIKAWA ! Version:: $Id: gt4_history_nmlinfo_test.f90,v 1.5 2007/12/22 10:38:15 morikawa Exp $ ! Tag Name:: $Name: gt4f90io-20080210 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2007. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! Note that Japanese and English are described in parallel. ! ! gt4_history_nmlinfo モジュールの動作テストを行うためのプログラムです. ! このプログラムがコンパイルできること, および実行時に ! プログラムが正常終了することを確認してください. ! ! This program checks the operation of "gt4_history_nmlinfo" module. ! Confirm compilation and execution of this program. ! program gt4_history_nmlinfo_test use gt4_history_nmlinfo, only: GT_HISTORY_NMLINFO, Create, Close, & & PutLine, initialized, Add, Delete, Inquire, & & output_step, output_valid, names, ResetDefault, & & EndDefine, define_mode, AssocGtHist, OutputStepDisable use gt4_history, only: GT_HISTORY, initialized, HistoryCreate, & & HistoryAddVariable, HistoryPut, HistoryClose, initialized use dc_test, only: AssertEqual, AssertGreaterThan, AssertLessThan use dc_types, only: DP, STRING, TOKEN use dc_string, only: StoA, PutLine use dc_args, only: ARGS, Open, HelpMsg, Option, Debug, Help, Strict, Close use dc_date_types, only: DC_DIFFTIME use dc_date, only: Create, operator(*) implicit none !------------------------------------------------------------------- ! 実験の表題, モデルの名称, 所属機関名 ! Title of a experiment, name of model, sub-organ !------------------------------------------------------------------- character(*), parameter:: title = & & 'gt4_history_nmlinfo_test $Name: gt4f90io-20080210 $ :: ' // & & 'Test program of "gt4_history_nmlinfo" module' character(*), parameter:: source = & & 'gtool4 project ' // & & '(See http://www.gfd-dennou.org/library/gtool4)' character(*), parameter:: institution = & & 'GFD Dennou Club (See http://www.gfd-dennou.org)' !------------------------------------------------------------------- ! 作業変数 ! Work variables !------------------------------------------------------------------- type(ARGS):: arg ! コマンドライン引数. ! Command line arguments logical:: OPT_namelist ! -N, --namelist オプションの有無. ! Existence of '-N', '--namelist' option character(STRING):: VAL_namelist ! -N, --namelist オプションの値. ! Value of '-N', '--namelist' option type(GT_HISTORY_NMLINFO):: gthstnml00, gthstnml01, gthstnml02, gthstnml03, gthstnml04 type(GT_HISTORY_NMLINFO):: gthstnml05, gthstnml06, gthstnml07, gthstnml08, gthstnml09 type(GT_HISTORY_NMLINFO):: gthstnml10, gthstnml11 logical:: err integer:: i type(DC_DIFFTIME):: interval_time character(STRING):: file ! ヒストリデータのファイル名. ! History data filenames real:: interval_value ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: precision ! ヒストリデータの精度. ! Precision of history data logical:: average ! 出力データの平均化フラグ. ! Flag for average of output data. character(STRING):: fileprefix ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames character(STRING):: varnames ! 変数名リスト. ! List of variables type(GT_HISTORY), pointer:: history00 =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module character(TOKEN):: name ! 変数名. Variable identifier !!$ character(*), parameter:: subname = 'gt4_history_nmlinfo_test' continue !------------------------------------------------------------------- ! コマンドライン引数の処理 ! Command line arguments handling !------------------------------------------------------------------- call Open( arg ) call HelpMsg( arg, 'Title', title ) call HelpMsg( arg, 'Usage', & & './gt4_history_nmlinfo_test [Options]' ) call HelpMsg( arg, 'Source', source ) call HelpMsg( arg, 'Institution', institution ) call Option( arg, StoA('-N', '--namelist'), & & OPT_namelist, VAL_namelist, help = 'NAMELIST filename' ) call Debug( arg ) ; call Help( arg ) ; call Strict( arg, severe = .true. ) call Close( arg ) !------------------------------------------------------------------- ! 基本の初期設定, 終了処理テスト ! Basic initialization and termination test !------------------------------------------------------------------- call Create( gthstnml = gthstnml00 ) ! (inout) call AssertEqual( 'basic initialization test 1', & & answer = .true., check = initialized(gthstnml00) ) call PutLine( gthstnml = gthstnml00 ) ! (in) call Close( gthstnml = gthstnml00 ) ! (inout) call AssertEqual( 'basic termination test 1', & & answer = .false., check = initialized(gthstnml00) ) call PutLine( gthstnml = gthstnml00 ) ! (in) call Create( gthstnml = gthstnml00, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'double', & ! (in) & average = .false. ) ! (in) call AssertEqual( 'basic initialization test 2', & & answer = .true., check = initialized(gthstnml00) ) call PutLine( gthstnml = gthstnml00 ) ! (in) call Close( gthstnml = gthstnml00 ) ! (inout) call AssertEqual( 'basic termination test 2', & & answer = .false., check = initialized(gthstnml00) ) call PutLine( gthstnml = gthstnml00 ) ! (in) !------------------------------------------------------------------- ! 重複初期設定に関するエラー処理のテスト ! Error handling related to duplicated initialization test !------------------------------------------------------------------- call Create( gthstnml = gthstnml00 ) ! (inout) call Create( gthstnml = gthstnml00, & ! (inout) & err = err ) ! (out) call AssertEqual( 'error handling related to duplicated initialization test 1', & & answer = .true., check = err ) call PutLine( gthstnml = gthstnml00 ) ! (in) call Close( gthstnml = gthstnml00 ) ! (inout) !------------------------------------------------------------------- ! 終了処理に関するエラー処理のテスト ! Error handling related to termination test !------------------------------------------------------------------- call Close( gthstnml = gthstnml00, & ! (inout) & err = err ) call AssertEqual( 'error handling related to termination test 1', & & answer = .true., check = err ) !------------------------------------------------------------------- ! 終了処理のテスト ! Termination test !------------------------------------------------------------------- call Create( gthstnml = gthstnml01, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min' ) ! (in) call Add( gthstnml = gthstnml01, & ! (inout) & name = 'Data1' ) ! (in) call Add( gthstnml = gthstnml01, & ! (inout) & name = 'Data2' ) ! (in) call Add( gthstnml = gthstnml01, & ! (inout) & name = 'Data3' ) ! (in) call Add( gthstnml = gthstnml01, & ! (inout) & name = 'Data4' ) ! (in) call Add( gthstnml = gthstnml01, & ! (inout) & name = 'Data5' ) ! (in) call PutLine( gthstnml = gthstnml01 ) ! (in) call Close( gthstnml = gthstnml01 ) ! (inout) !------------------------------------------------------------------- ! 無効な値に関するエラー処理のテスト ! Error handling related to invalid values test !------------------------------------------------------------------- call Create( gthstnml = gthstnml02, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'hogehoge', & ! (in) & precision = 'double', & ! (in) & average = .false., & ! (in) & err = err ) ! (out) call PutLine( gthstnml = gthstnml02 ) ! (in) call AssertEqual( 'error handling related to invalid values test 1', & & answer = .true., check = err ) call Create( gthstnml = gthstnml02, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'hour', & ! (in) & precision = 'double', & ! (in) & average = .false. ) ! (in) call PutLine( gthstnml = gthstnml02 ) ! (in) call Add( gthstnml = gthstnml02, & ! (inout) & name = 'Data1', & ! (in) & interval_value = 3.0, & ! (in) & interval_unit = 'foo', & ! (in) & err = err ) ! (out) call PutLine( gthstnml = gthstnml02 ) ! (in) call AssertEqual( 'error handling related to invalid values test 2', & & answer = .true., check = err ) call Close( gthstnml = gthstnml02 ) ! (inout) !------------------------------------------------------------------- ! データ操作のテスト ! Data handling test !------------------------------------------------------------------- call Create( gthstnml = gthstnml03, & ! (inout) & interval_value = 30.0, & ! (in) & interval_unit = 'min' ) ! (in) call Inquire( gthstnml = gthstnml03, & ! (in) & name = '', & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average ) ! (out) call AssertEqual( 'data handling test 1-1', & & answer = '', check = file ) call AssertEqual( 'data handling test 1-2', & & answer = 30.0, check = interval_value, & & significant_digits = 7, ignore_digits = -6 ) call AssertEqual( 'data handling test 1-3', & & answer = 'min', check = interval_unit ) call AssertEqual( 'data handling test 1-4', & & answer = 'float', check = precision ) call AssertEqual( 'data handling test 1-5', & & answer = .false., check = average ) call Add( gthstnml = gthstnml03, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'double' ) ! (in) call PutLine( gthstnml = gthstnml03 ) ! (in) call Add( gthstnml = gthstnml03, & ! (inout) & name = 'Data1', & ! (in) & precision = 'double' ) ! (in) call PutLine( gthstnml = gthstnml03 ) ! (in) call Add( gthstnml = gthstnml03, & ! (inout) & name = 'Data2', & ! (in) & file = 'Data2.nc', & ! (in) & interval_value = 5.0, & ! (in) & interval_unit = 'hour' ) ! (in) call PutLine( gthstnml = gthstnml03 ) ! (in) call Add( gthstnml = gthstnml03, & ! (inout) & name = 'Data3', & ! (in) & interval_value = -1.0 ) ! (in) call PutLine( gthstnml = gthstnml03 ) ! (in) call Inquire( gthstnml = gthstnml03, & ! (in) & name = 'Data2', & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average ) ! (out) call AssertEqual( 'data handling test 2-1', & & answer = 'Data2.nc', check = file ) call AssertEqual( 'data handling test 2-2', & & answer = 5.0, check = interval_value, & & significant_digits = 7, ignore_digits = -6 ) call AssertEqual( 'data handling test 2-3', & & answer = 'hour', check = interval_unit ) call AssertEqual( 'data handling test 2-4', & & answer = 'double', check = precision ) call AssertEqual( 'data handling test 2-5', & & answer = .false., check = average ) call Delete( gthstnml = gthstnml03, & ! (inout) & name = 'Data2' ) ! (in) call PutLine( gthstnml = gthstnml03 ) ! (in) call Inquire( gthstnml = gthstnml03, & ! (in) & name = 'Data2', & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average, & ! (out) & err = err ) ! (out) call AssertEqual( 'data handling test 3-1', & & answer = .true., check = err ) call Inquire( gthstnml = gthstnml03, & ! (in) & name = 'Data1', & ! (in) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average ) ! (out) call AssertEqual( 'data handling test 2-2', & & answer = 3.0, check = interval_value, & & significant_digits = 7, ignore_digits = -6 ) call AssertEqual( 'data handling test 2-3', & & answer = 'min', check = interval_unit ) call AssertEqual( 'data handling test 2-4', & & answer = 'double', check = precision ) call AssertEqual( 'data handling test 2-5', & & answer = .false., check = average ) call Add( gthstnml = gthstnml03, & ! (inout) & interval_value = 1.0, & ! (in) & interval_unit = 'day', & ! (in) & precision = 'float', & ! (in) & average = .true. ) ! (in) call Inquire( gthstnml = gthstnml03, & ! (in) & name = 'Data1', & ! (in) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average ) ! (out) call AssertEqual( 'data handling test 2-2', & & answer = 1.0, check = interval_value, & & significant_digits = 7, ignore_digits = -6 ) call AssertEqual( 'data handling test 2-3', & & answer = 'day', check = interval_unit ) call AssertEqual( 'data handling test 2-4', & & answer = 'double', check = precision ) call AssertEqual( 'data handling test 2-5', & & answer = .true., check = average ) call AssertEqual( 'data handling test 4-1', & & answer = .true., & & check = output_valid( gthstnml = gthstnml03, name = '' ) ) call AssertEqual( 'data handling test 4-2', & & answer = .true., & & check = output_valid( gthstnml = gthstnml03, name = 'Data1' ) ) call AssertEqual( 'data handling test 4-3', & & answer = .false., & & check = output_valid( gthstnml = gthstnml03, name = 'Data2' ) ) call AssertEqual( 'data handling test 4-4', & & answer = .false., & & check = output_valid( gthstnml = gthstnml03, name = 'Data3' ) ) call Close( gthstnml = gthstnml03 ) ! (inout) !------------------------------------------------------------------- ! 出力ステップ問い合わせのテスト ! Inquire output step test !------------------------------------------------------------------- call Create( gthstnml = gthstnml04, & ! (inout) & interval_value = 30.0, & ! (in) & interval_unit = 'min' ) ! (in) call Add( gthstnml = gthstnml04, & ! (inout) & name = 'Data1', & ! (in) & file = 'Data1.nc', & ! (in) & interval_value = 1.0, & ! (in) & interval_unit = 'hour' ) ! (in) call Add( gthstnml = gthstnml04, & ! (inout) & name = 'Data2', & ! (in) & file = 'Data2.nc', & ! (in) & interval_value = -1.0 ) ! (in) call Create( & & diff = interval_time, & ! (out) & value = 6.0_DP, & ! (in) & unit = 'sec' ) ! (in) call AssertEqual( 'inquire output step test 1-1', & & answer = .false., & & check = output_step( gthstnml = gthstnml04, name = 'Data2', time = interval_time ) ) call AssertEqual( 'inquire output step test 1-2', & & answer = .false., & & check = output_step( gthstnml = gthstnml04, name = '', time = interval_time ) ) call AssertEqual( 'inquire output step test 1-3', & & answer = .true., & & check = output_step( gthstnml = gthstnml04, name = '', time = interval_time * 300 ) ) call AssertEqual( 'inquire output step test 1-4', & & answer = .false., & & check = output_step( gthstnml = gthstnml04, name = 'Data1', time = interval_time * 300 ) ) call AssertEqual( 'inquire output step test 1-5', & & answer = .true., & & check = output_step( gthstnml = gthstnml04, name = 'Data1', time = interval_time * 600 ) ) call OutputStepDisable( gthstnml = gthstnml04, & ! (inout) & name = 'Data1', & ! (in) & err = err ) ! (out) call AssertEqual( 'inquire output step test 2-1', & & answer = .true., check = err ) call EndDefine( gthstnml = gthstnml04 ) ! (inout) call OutputStepDisable( gthstnml = gthstnml04, & ! (inout) & name = 'Data1' ) ! (in) call AssertEqual( 'inquire output step test 2-2', & & answer = .false., & & check = output_step( gthstnml = gthstnml04, name = 'Data1', time = interval_time * 600 ) ) call Close( gthstnml = gthstnml04 ) ! (inout) !------------------------------------------------------------------- ! fileprefix テスト ! fileprefix test !------------------------------------------------------------------- call Create( gthstnml = gthstnml05, & ! (inout) & interval_value = 30.0, & ! (in) & interval_unit = 'min', & ! (in) & fileprefix = 'hoge/' ) ! (in) call Add( gthstnml = gthstnml05, & ! (inout) & name = 'Data1' ) ! (in) call PutLine( gthstnml = gthstnml05 ) ! (in) call Inquire( gthstnml = gthstnml05, & ! (in) & name = '', & ! (in) & file = file, & ! (out) & fileprefix = fileprefix ) ! (out) call AssertEqual( 'fileprefix test 1-1', & & answer = '', check = file ) call AssertEqual( 'fileprefix test 1-2', & & answer = 'hoge/', check = fileprefix ) call Inquire( gthstnml = gthstnml05, & ! (in) & name = ' Data1', & ! (in) & file = file, & ! (out) & fileprefix = fileprefix ) ! (out) call AssertEqual( 'fileprefix test 2-1', & & answer = 'hoge/Data1.nc', check = file ) call AssertEqual( 'fileprefix test 2-2', & & answer = 'hoge/', check = fileprefix ) call Add( gthstnml = gthstnml05, & ! (inout) & name = '', & ! (in) & fileprefix = 'foo/bar_' ) ! (in) call Inquire( gthstnml = gthstnml05, & ! (in) & name = '', & ! (in) & file = file, & ! (out) & fileprefix = fileprefix ) ! (out) call AssertEqual( 'fileprefix test 3-1', & & answer = '', check = file ) call AssertEqual( 'fileprefix test 3-2', & & answer = 'foo/bar_', check = fileprefix ) call Inquire( gthstnml = gthstnml05, & ! (in) & name = 'Data1', & ! (in) & file = file, & ! (out) & fileprefix = fileprefix ) ! (out) call AssertEqual( 'fileprefix test 4-1', & & answer = 'foo/bar_Data1.nc', check = file ) call AssertEqual( 'fileprefix test 4-2', & & answer = 'foo/bar_', check = fileprefix ) !------------------------------------------------------------------- ! names テスト ! "names" test !------------------------------------------------------------------- varnames = names( gthstnml06 ) call AssertEqual( '"names" test 1-1', & & answer = '', check = varnames ) call Create( gthstnml = gthstnml06, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min' ) ! (in) call Add( gthstnml = gthstnml06, & ! (inout) & name = 'Data1' ) ! (in) call Add( gthstnml = gthstnml06, & ! (inout) & name = 'Data2' ) ! (in) call Add( gthstnml = gthstnml06, & ! (inout) & name = 'Data3' ) ! (in) call Add( gthstnml = gthstnml06, & ! (inout) & name = 'Data4' ) ! (in) call Add( gthstnml = gthstnml06, & ! (inout) & name = 'Data5' ) ! (in) call Delete( gthstnml = gthstnml06, & ! (inout) & name = 'Data3' ) ! (in) call PutLine( gthstnml = gthstnml06 ) ! (in) varnames = names( gthstnml06 ) call AssertEqual( '"names" test 1-2', & & answer = 'Data1,Data2,Data4,Data5', check = varnames ) call Close( gthstnml = gthstnml06 ) ! (inout) !------------------------------------------------------------------- ! ResetDefault テスト ! "ResetDefault" test !------------------------------------------------------------------- call Create( gthstnml = gthstnml07, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min' ) ! (in) call Add( gthstnml = gthstnml07, & ! (inout) & name = 'Data1' ) ! (in) call Add( gthstnml = gthstnml07, & ! (inout) & name = 'Data2' ) ! (in) call PutLine( gthstnml = gthstnml07 ) ! (in) call ResetDefault( gthstnml = gthstnml07 ) ! (inout) call PutLine( gthstnml = gthstnml07 ) ! (in) varnames = names( gthstnml07 ) call AssertEqual( '"ResetDefault" test 1-1', & & answer = '', check = varnames ) call AssertEqual( '"ResetDefault" test 1-2', & & answer = .true., check = initialized( gthstnml07 ) ) call Inquire( gthstnml = gthstnml07, & ! (in) & name = '', & ! (in) & interval_value = interval_value, & ! (in) & interval_unit = interval_unit ) ! (in) call AssertEqual( '"ResetDefault" test 1-3', & & answer = 3.0, check = interval_value ) call AssertEqual( '"ResetDefault" test 1-4', & & answer = 'min', check = interval_unit ) call Close( gthstnml = gthstnml07 ) ! (inout) !------------------------------------------------------------------- ! 複数変数操作テスト ! Multiple variables handling test !------------------------------------------------------------------- call Create( gthstnml = gthstnml08, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min' ) ! (in) call Add( gthstnml = gthstnml08, & ! (inout) & name = 'Data1, Data2, Data3, Data4', & ! (in) & file = 'multi.nc', & ! (in) & interval_value = 2.0, & ! (in) & interval_unit = 'hour' ) ! (in) call Add( gthstnml = gthstnml08, & ! (inout) & precision = 'double' ) ! (in) call PutLine( gthstnml = gthstnml08 ) ! (in) varnames = names( gthstnml08 ) call AssertEqual( 'multiple variables handling test 1-1', & & answer = 'Data1,Data2,Data3,Data4', check = varnames ) call Delete( gthstnml = gthstnml08, & ! (inout) & name = 'Data2, Data3' ) ! (in) call PutLine( gthstnml = gthstnml08 ) ! (in) varnames = names( gthstnml08 ) call AssertEqual( 'multiple variables handling test 1-1', & & answer = 'Data1,Data4', check = varnames ) call Close( gthstnml = gthstnml08 ) ! (inout) !------------------------------------------------------------------- ! 出力モードテストその1 (基本的な出力) ! Output mode test part 1 (Basic outout) !------------------------------------------------------------------- call Create( gthstnml = gthstnml09, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'double', & ! (in) & fileprefix = 'xgt4_history_nmlinfo_test/' ) ! (in) call AssertEqual( 'define mode check test 1-1', & & answer = .true., check = define_mode( gthstnml09 ) ) call Add( gthstnml = gthstnml09, & ! (inout) & name = 'Data1' ) ! (in) call AssertEqual( 'define mode check test 1-2', & & answer = .true., check = define_mode( gthstnml09 ) ) call PutLine( gthstnml = gthstnml09 ) ! (in) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & history = history00, & ! (out) & err = err ) ! (out) call AssertEqual( 'define mode check test 1-3', & & answer = .true., check = err ) call EndDefine( gthstnml = gthstnml09 ) ! (inout) call AssertEqual( 'define mode check test 1-4', & & answer = .false., check = define_mode( gthstnml09 ) ) call PutLine( gthstnml = gthstnml09 ) ! (in) call Add( gthstnml = gthstnml09, & ! (inout) & name = 'Data2', & ! (in) & err = err ) ! (out) call AssertEqual( 'output mode error handling test 1-1', & & answer = .true., check = err ) call Delete( gthstnml = gthstnml09, & ! (inout) & name = 'Data1', & ! (in) & err = err ) ! (out) call AssertEqual( 'output mode error handling test 1-2', & & answer = .true., check = err ) call ResetDefault( gthstnml = gthstnml09, & ! (inout) & err = err ) ! (out) call AssertEqual( 'output mode error handling test 1-3', & & answer = .true., check = err ) call PutLine( gthstnml = gthstnml09 ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'DataX', & ! (in) & history = history00, & ! (out) & err = err ) call AssertEqual( 'output mode AssocGtHist test 1-1', & & answer = .true., check = err ) call AssertEqual( 'output mode AssocGtHist test 1-2', & & answer = .false., check = associated( history00 ) ) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & history = history00 ) ! (out) call AssertEqual( 'output mode AssocGtHist test 1-3', & & answer = .true., check = associated( history00 ) ) call AssertEqual( 'output mode AssocGtHist test 1-4', & & answer = .false., check = initialized( history00 ) ) call Inquire( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit ) ! (out) call HistoryCreate( & & history = history00, & ! (out) & file = file, title = 'Data1', & ! (in) & source = source, institution = institution, & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & dimsizes = (/4, 2, 0/), & ! (in) & longnames = StoA('longitude', 'latitude', 'time'), & ! (in) & units = StoA('degree_east', 'degree_north', & & interval_unit), & ! (in) & origin = 0.0, & ! (in) & interval = real( interval_value ) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lon', array = (/0.0, 90.0, 180.0, 270.0/) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lat', array = (/-40.0, 40.0/) ) ! (in) call PutLine( gthstnml = gthstnml09 ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & history = history00 ) ! (out) call Inquire( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & precision = precision ) ! (out) call HistoryAddVariable( & & history = history00, & ! (inout) & varname = 'Data1', & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & longname = 'sample data 1', & ! (in) & units = 'm s-1', xtype = precision ) ! (in) call PutLine( gthstnml = gthstnml09 ) ! (in) do i = 1, 3 nullify( history00 ) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & history = history00 ) ! (out) call HistoryPut( & & history = history00, & ! (inout) & varname = 'Data1', & ! (in) & array = reshape( (/1, 2, 3, 4, 5, 6, 7, 8/) * i, & & (/4, 2/) ) ) ! (in) end do call PutLine( gthstnml = gthstnml09 ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml09, & ! (in) & name = 'Data1', & ! (in) & history = history00 ) ! (out) call HistoryClose( & & history = history00 ) ! (inout) call Close( gthstnml = gthstnml09 ) ! (inout) !------------------------------------------------------------------- ! 出力モードテストその2 (複数の変数を1つのファイルへ) ! Output mode test part 2 (Multi variables are output to one file) !------------------------------------------------------------------- call Create( gthstnml = gthstnml10, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'double', & ! (in) & fileprefix = 'xgt4_history_nmlinfo_test/' ) ! (in) call Inquire( gthstnml = gthstnml10, & ! (in) & name = '', & ! (in) & fileprefix = fileprefix ) ! (out) call Add( gthstnml = gthstnml10, & ! (inout) & name = 'Data2,Data3', & ! (in) & file = trim( fileprefix ) // 'Data2_3_4.nc' ) ! (in) call Add( gthstnml = gthstnml10, & ! (inout) & name = 'Data4', & ! (in) & file = trim( fileprefix ) // 'Data2_3_4.nc', & ! (in) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'float' ) ! (in) call Add( gthstnml = gthstnml10, & ! (inout) & name = 'DataX', & ! (in) & file = trim( fileprefix ) // 'Data2_3_4.nc', & ! (in) & interval_value = 6.0 ) ! (in) call EndDefine( gthstnml = gthstnml10, & ! (inout) & err = err ) ! (out) call AssertEqual( 'multi files output error handling test 1-1', & & answer = .true., check = err ) call Add( gthstnml = gthstnml10, & ! (inout) & name = 'DataX', & ! (in) & file = trim( fileprefix ) // 'Data2_3_4.nc', & ! (in) & interval_unit = 'hour' ) ! (in) call EndDefine( gthstnml = gthstnml10, & ! (inout) & err = err ) ! (out) call AssertEqual( 'multi files output error handling test 1-2', & & answer = .true., check = err ) call Delete( gthstnml = gthstnml10, & ! (inout) & name = 'DataX' ) ! (in) call EndDefine( gthstnml = gthstnml10 ) ! (inout) call AssertEqual( 'multi files output error handling test 1-3', & & answer = .false., check = define_mode( gthstnml10 ) ) call PutLine( gthstnml = gthstnml10 ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & history = history00 ) ! (out) call Inquire( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit ) ! (out) call HistoryCreate( & & history = history00, & ! (out) & file = file, & ! (in) & title = 'Data2_3_4 multi variable output', & ! (in) & source = source, institution = institution, & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & dimsizes = (/4, 2, 0/), & ! (in) & longnames = StoA('longitude', 'latitude', 'time'), & ! (in) & units = StoA('degree_east', 'degree_north', & & interval_unit), & ! (in) & origin = 0.0, & ! (in) & interval = real( interval_value ) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lon', array = (/0.0, 90.0, 180.0, 270.0/) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lat', array = (/-40.0, 40.0/) ) ! (in) call PutLine( gthstnml = gthstnml10 ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & history = history00 ) ! (out) call Inquire( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & precision = precision ) ! (out) call HistoryAddVariable( & & history = history00, & ! (inout) & varname = 'Data2', & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & longname = 'sample data 2', & ! (in) & units = 'm s-1', xtype = precision ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data3', & ! (in) & history = history00 ) ! (out) call AssertEqual( 'multi files output test 1-1', & & answer = .true., check = initialized( history00 ) ) call Inquire( gthstnml = gthstnml10, & ! (in) & name = 'Data3', & ! (in) & precision = precision ) ! (out) call HistoryAddVariable( & & history = history00, & ! (inout) & varname = 'Data3', & ! (in) & dims = StoA('lon', 'time'), & ! (in) & longname = 'sample data 3', & ! (in) & units = 'm s-1', xtype = precision ) ! (in) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data4', & ! (in) & history = history00 ) ! (out) call AssertEqual( 'multi files output test 1-2', & & answer = .true., check = initialized( history00 ) ) call Inquire( gthstnml = gthstnml10, & ! (in) & name = 'Data4', & ! (in) & precision = precision ) ! (out) call HistoryAddVariable( & & history = history00, & ! (inout) & varname = 'Data4', & ! (in) & dims = StoA('lat', 'time'), & ! (in) & longname = 'sample data 4', & ! (in) & units = 'm s-1', xtype = precision ) ! (in) call PutLine( gthstnml = gthstnml10 ) ! (in) do i = 1, 3 nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & history = history00 ) ! (out) call HistoryPut( & & history = history00, & ! (inout) & varname = 'Data2', & ! (in) & array = reshape( (/1, 2, 3, 4, 5, 6, 7, 8/) * i, & & (/4, 2/) ) ) ! (in) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data3', & ! (in) & history = history00 ) ! (out) call HistoryPut( & & history = history00, & ! (inout) & varname = 'Data3', & ! (in) & array = (/10, 20, 30, 40/) * i ) ! (in) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data4', & ! (in) & history = history00 ) ! (out) call HistoryPut( & & history = history00, & ! (inout) & varname = 'Data4', & ! (in) & array = (/100, 200 /) * i) ! (in) end do nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data2', & ! (in) & history = history00 ) ! (out) call HistoryClose( & & history = history00 ) ! (inout) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data3', & ! (in) & history = history00 ) ! (out) call AssertEqual( 'multi files output test 2-1', & & answer = .false., check = initialized( history00 ) ) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml10, & ! (in) & name = 'Data4', & ! (in) & history = history00 ) ! (out) call AssertEqual( 'multi files output test 2-2', & & answer = .false., check = initialized( history00 ) ) call Close( gthstnml = gthstnml10 ) ! (inout) !------------------------------------------------------------------- ! 出力モードテストその3 (Close のエラー処理) ! Output mode test part 3 (error handling in Close) !------------------------------------------------------------------- call Create( gthstnml = gthstnml11, & ! (inout) & interval_value = 3.0, & ! (in) & interval_unit = 'min', & ! (in) & precision = 'double', & ! (in) & fileprefix = 'xgt4_history_nmlinfo_test/' ) ! (in) call Add( gthstnml = gthstnml11, & ! (inout) & name = 'Data5,Data6' ) ! (in) call EndDefine( gthstnml = gthstnml11 ) ! (inout) do i = 1, 2 select case (i) case (1) ; name = 'Data5' case (2) ; name = 'Data6' case default ; name = '' end select nullify( history00 ) call AssocGtHist( gthstnml = gthstnml11, & ! (in) & name = name, & ! (in) & history = history00 ) ! (out) call Inquire( gthstnml = gthstnml11, & ! (in) & name = name, & ! (in) & file = file, & ! (out) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit ) ! (out) call HistoryCreate( & & history = history00, & ! (out) & file = file, & ! (in) & title = name, & ! (in) & source = source, institution = institution, & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & dimsizes = (/4, 2, 0/), & ! (in) & longnames = StoA('longitude', 'latitude', 'time'), & ! (in) & units = StoA('degree_east', 'degree_north', & & interval_unit), & ! (in) & origin = 0.0, & ! (in) & interval = real( interval_value ) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lon', array = (/0.0, 90.0, 180.0, 270.0/) ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = 'lat', array = (/-40.0, 40.0/) ) ! (in) call HistoryAddVariable( & & history = history00, & ! (inout) & varname = name, & ! (in) & dims = StoA('lon', 'lat', 'time'), & ! (in) & longname = 'sample ' // name, & ! (in) & units = 'm s-1', xtype = precision ) ! (in) call HistoryPut( & & history = history00, & ! (inout) & varname = name, & ! (in) & array = reshape( (/1, 2, 3, 4, 5, 6, 7, 8/) * i, & & (/4, 2/) ) ) ! (in) end do nullify( history00 ) call AssocGtHist( gthstnml = gthstnml11, & ! (in) & name = 'Data5', & ! (in) & history = history00 ) ! (out) call HistoryClose( & & history = history00 ) ! (inout) call Close( gthstnml = gthstnml11, & ! (inout) & err = err ) ! (out) call AssertEqual( 'error handling in "Close" test 1-1', & & answer = .true., check = err ) nullify( history00 ) call AssocGtHist( gthstnml = gthstnml11, & ! (in) & name = 'Data6', & ! (in) & history = history00 ) ! (out) call HistoryClose( & & history = history00 ) ! (inout) call Close( gthstnml = gthstnml11 ) ! (inout) end program gt4_history_nmlinfo_test