constants_test.f90

Path: shared/constants_test.f90
Last Update: Thu Jul 26 17:33:36 JST 2007

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

Test program for "constants"

Authors:Yasuhiro MORIKAWA
Version:$Id: constants_test.f90,v 1.6 2007/07/26 08:33:36 morikawa Exp $
Tag Name:$Name: dcpam4-20070730-2 $
Copyright:Copyright (C) GFD Dennou Club, 2007. All rights reserved.

License::

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.

Required files

shared/constants.f90  

Methods

constants_test  

Included Modules

constants dc_test dc_types dc_string dc_args

Public Instance methods

constants_test
Main Program :

[Source]

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

[Validate]