Path: | shared/const_provider_test.f90 |
Last Update: | Tue Apr 22 21:41:12 +0900 2008 |
Authors: | Yasuhiro MORIKAWA |
Version: | $Id: const_provider_test.f90,v 1.1 2008-04-22 12:41:12 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.
const_provider モジュールの動作テストを行うためのプログラムです. このプログラムがコンパイルできること, および実行時に プログラムが正常終了することを確認してください.
This program checks the operation of "const_provider" module. Confirm compilation and execution of this program.
Main Program : |
program const_provider_test use const_provider, only: ConstGet use dc_test, only: AssertEqual use dc_types, only: DP, STRING use dc_string, only: StoA use dc_args, only: ARGS, DCArgsOpen, DCArgsHelpMsg, DCArgsOption, DCArgsDebug, DCArgsHelp, DCArgsStrict, DCArgsClose implicit none !--------------------------------------------------------- ! 実験の表題, モデルの名称, 所属機関名 ! Title of a experiment, name of model, sub-organ !--------------------------------------------------------- character(*), parameter:: title = 'const_provider_test $Name: dcpam4-20080624-1 $ :: ' // 'Test program of "const_provider" 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)' !--------------------------------------------------------- ! 物理定数 ! Physical constants !--------------------------------------------------------- real(DP):: PI ! $ \pi $ . ! 円周率. Circular constant real(DP):: RPlanet ! $ a $ [m]. ! 惑星半径. ! Radius of planet real(DP):: Omega ! $ \Omega $ [s-1]. ! 回転角速度. ! Angular velocity real(DP):: Grav ! $ g $ [m s-2]. ! 重力加速度. ! Gravitational acceleration !--------------------------------------------------------- ! 作業変数 ! Work variables !--------------------------------------------------------- type(ARGS) :: arg logical:: OPT_namelist character(STRING):: VAL_namelist character(*), parameter:: subname = 'const_provider_test' continue !------------------------------------------------------------------- ! コマンドライン引数の処理 ! Command line options handling !------------------------------------------------------------------- call cmdline_optparse ! これは内部サブルーチン. This is an internal subroutine !--------------------------------------------------------- ! ConstGet のテスト ! Test of "ConstGet" !--------------------------------------------------------- call ConstGet( PI = PI ) ! (out) call AssertEqual( 'ConstGet test 1-1', answer = 3.1415926535897930_DP, check = PI, significant_digits = 15, ignore_digits = -15 ) call ConstGet( planet = 'earth', RPlanet = RPlanet, Omega = Omega, Grav = Grav ) ! (out) call AssertEqual( 'ConstGet test 2-1', answer = 6.371e6_DP, check = RPlanet, significant_digits = 15, ignore_digits = -15 ) call AssertEqual( 'ConstGet test 2-2', answer = 7.29210659088065e-05_DP, check = Omega, significant_digits = 15, ignore_digits = -15 ) call AssertEqual( 'ConstGet test 2-3', answer = 9.8_DP, check = Grav, significant_digits = 15, ignore_digits = -15 ) call ConstGet( planet = 'jupiter00', RPlanet = RPlanet, Omega = Omega, Grav = Grav ) ! (out) call AssertEqual( 'ConstGet test 3-1', answer = 7.1492e7_DP, check = RPlanet, significant_digits = 15, ignore_digits = -15 ) call AssertEqual( 'ConstGet test 3-2', answer = 1.75851813802955e-4_DP, check = Omega, significant_digits = 15, ignore_digits = -15 ) call AssertEqual( 'ConstGet test 3-3', answer = 23.1_DP, check = Grav, significant_digits = 15, ignore_digits = -15 ) contains subroutine cmdline_optparse ! ! コマンドライン引数の処理を行います ! ! Handle command line options ! call DCArgsOpen( arg = arg ) ! (out) call DCArgsHelpMsg( arg = arg, category = 'Title', msg = title ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Usage', msg = './' // trim(subname) // ' [Options]' ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Source', msg = source ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Institution', msg = institution ) ! (in) call DCArgsOption( arg = arg, options = StoA('-N', '--namelist'), flag = OPT_namelist, value = VAL_namelist, help = "Namelist filename") ! (in) call DCArgsDebug( arg = arg ) ! (inout) call DCArgsHelp( arg = arg ) ! (inout) call DCArgsStrict( arg = arg ) ! (inout) call DCArgsClose( arg = arg ) ! (inout) end subroutine cmdline_optparse end program const_provider_test
Subroutine : |
コマンドライン引数の処理を行います
Handle command line options
subroutine cmdline_optparse ! ! コマンドライン引数の処理を行います ! ! Handle command line options ! call DCArgsOpen( arg = arg ) ! (out) call DCArgsHelpMsg( arg = arg, category = 'Title', msg = title ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Usage', msg = './' // trim(subname) // ' [Options]' ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Source', msg = source ) ! (in) call DCArgsHelpMsg( arg = arg, category = 'Institution', msg = institution ) ! (in) call DCArgsOption( arg = arg, options = StoA('-N', '--namelist'), flag = OPT_namelist, value = VAL_namelist, help = "Namelist filename") ! (in) call DCArgsDebug( arg = arg ) ! (inout) call DCArgsHelp( arg = arg ) ! (inout) call DCArgsStrict( arg = arg ) ! (inout) call DCArgsClose( arg = arg ) ! (inout) end subroutine cmdline_optparse