Path: | shared/constants_test.f90 |
Last Update: | Fri Aug 03 15:45:22 +0900 2007 |
Authors: | Yasuhiro MORIKAWA |
Version: | $Id: constants_test.f90,v 1.7 2007-08-03 06:45:22 morikawa Exp $ |
Tag Name: | $Name: dcpam4-20080624-1 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2007. All rights reserved. |
License: | See COPYRIGHT |
Note that Japanese and English are described in parallel.
constants モジュールの動作テストを行うためのプログラムです. このプログラムがコンパイルできること, および実行時に プログラムが正常終了することを確認してください.
This program checks the operation of "constants" module. Confirm compilation and execution of this program.
Main Program : |
program constants_test use constants, only: CONST, Create, PutLine, initialized, Get use dc_test, only: AssertEqual use dc_types, only: DP, STRING use dc_string, only: StoA use dc_args, only: ARGS, Open, HelpMsg, Option, Debug, Help, Strict, Close implicit none !--------------------------------------------------------- ! 実験の表題, モデルの名称, 所属機関名 ! Title of a experiment, name of model, sub-organ !--------------------------------------------------------- character(*), parameter:: title = 'constants_test $Name: dcpam4-20080624-1 $ :: ' // 'Test program of "constants" module' character(*), parameter:: source = 'dcpam4 ' // '(See http://www.gfd-dennou.org/library/dcpam)' character(*), parameter:: institution = 'GFD Dennou Club (See http://www.gfd-dennou.org)' !--------------------------------------------------------- ! 作業変数 ! Work variables !--------------------------------------------------------- type(ARGS) :: arg type(CONST) :: const0, const1 logical:: OPT_namelist character(STRING):: VAL_namelist real(DP):: RPlanet ! $ a $ . 惑星半径. Radius of planet real(DP):: Omega ! $ \Omega $ . 回転角速度. Angular velocity continue !--------------------------------------------------------- ! コマンドライン引数の処理 ! Command line arguments handling !--------------------------------------------------------- call Open( arg ) call HelpMsg( arg, 'Title', title ) call HelpMsg( arg, 'Usage', './constants_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 ) !--------------------------------------------------------- ! 初期設定テスト ! Initialization test !--------------------------------------------------------- call Create(const0, Omega = 7.088e-5_DP ) ! (in) call AssertEqual( 'Initialization test 1', answer = .true., check = initialized(const0) ) call PutLine(const0) ! (in) call Get(const0, RPlanet = RPlanet, Omega = Omega) ! (out) call AssertEqual( 'Initialization test 2', answer = 6.371e6_DP, check = RPlanet ) call AssertEqual( 'Initialization test 3', answer = 7.088e-5_DP, check = Omega ) !--------------------------------------------------------- ! NAMELIST 読み込みテスト ! Loading NAMELIST test !--------------------------------------------------------- call Create(const1, Omega = 7.088e-5_DP, nmlfile = VAL_namelist) ! (in) call AssertEqual( 'Loading NAMELIST test 1', answer = .true., check = initialized(const1) ) call PutLine(const1) ! (in) call Get(const1, RPlanet = RPlanet, Omega = Omega) ! (out) call AssertEqual( 'Loading NAMELIST test 2', answer = 3.371e6_DP, check = RPlanet ) call AssertEqual( 'Loading NAMELIST test 3', answer = 4.292e-5_DP, check = Omega ) end program constants_test