const_provider_test.f90

Path: shared/const_provider_test.f90
Last Update: Tue Apr 22 21:41:12 +0900 2008

const_provider モジュールのテストプログラム

Test program for "const_provider"

Authors:Yasuhiro MORIKAWA
Version:$Id: const_provider_test.f90,v 1.1 2008-04-22 12:41:12 morikawa Exp $
Tag Name:$Name: dcpam4-20080626 $
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.

Required files

Methods

Included Modules

const_provider dc_test dc_types dc_string dc_args

Public Instance methods

Main Program :

[Source]

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-20080626 $ :: ' // '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

Private Instance methods

Subroutine :

コマンドライン引数の処理を行います

Handle command line options

[Source]

  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

[Validate]