#!/usr/bin/env ruby
#
#= Fortran 90/95 dcmodel sample code maker
#
#Authors:: Yasuhiro MORIKAWA
#Version:: $Id: dcmodel_f90sample_maker.rb,v 1.26 2007/07/31 02:38:13 morikawa Exp $
#Tag Name:: $Name: dcpam4-20070731-1 $
#Copyright:: Copyright (C) GFD Dennou Club, 2007. All rights reserved.
#License:: See COPYRIGHT[link:../../COPYRIGHT]
#
#引数として受け取るキーワードに応じ, {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]
#に基づく Fortran 90/95 ソースコードの雛形となるコードを標準出力に書き出す.
#
require "optparse"
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコードの雛形となるコードを生成するためのクラス.
#
class DCModelF90SampleMaker
#
#作成するコードの種類に応じ, 第1引数 *entity* には
#'module' (モジュール全体), 'procedure' (手続), 'type' (構造型定義)
#を与える. 第1引数に 'procedure' を与えた場合のみ, 第2引数 *proc_kind*
#が有効となり, ここに手続きの種類を与える. 詳しくは
#DCModelF90SampleMaker を参照のこと.
#
#現在, 第3引数は無効.
#
def initialize(entity, proc_kind='other', quiet=nil)
case entity
when 'module'
@entity = DCModelF90SampleModuleMaker.new
@test = DCModelF90SampleTestMaker.new
@testnml = DCModelF90SampleTestNmlMaker.new
@testsh = DCModelF90SampleTestShMaker.new
when 'procedure'
@entity = DCModelF90SampleProcMaker.new(proc_kind)
when 'type'
@entity = DCModelF90SampleTypeMaker.new
else
raise ArgumentError, " Error: @entity = \"#{entity}\" is invalid."
end
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@entity.interactive_setup
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @entity.filename
end
#
# テストファイル名としてふさわしい名前を返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def test_filename
if @test
@test.set_modname(@entity.mod_name)
return @test.filename
else
return ''
end
end
#
# テスト用 NAMELIST ファイル名としてふさわしい名前を返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def testnml_filename
if @testnml
@testnml.set_modname(@entity.mod_name)
return @testnml.filename
else
return ''
end
end
#
# テスト実行用シェルスクリプトファイル名としてふさわしい名前を返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def testsh_filename
if @testsh
@testsh.set_modname(@entity.mod_name)
return @testsh.filename
else
return ''
end
end
#
# 日本語ドキュメントが不要な場合にこのメソッドを呼ぶ
#
def no_lang_ja
return @entity.lang_ja = false
end
#
# F90 ソースコードを返す.
#
def to_s
return @entity.to_s
end
#
# テストプログラムのソースコードを返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def test_to_s
if @test
@test.set_modname(@entity.mod_name)
@test.set_basename(@entity.mod_basename)
@test.set_arg_type(@entity.mod_arg_type)
@test.set_arg_keyword(@entity.mod_arg_keyword)
@test.set_author(@entity.author)
@test.set_copyright(@entity.copyright)
@test.lang_ja = @entity.lang_ja
return @test.to_s
else
return ''
end
end
#
# テストプログラム用 NAMELIST ファイルの中身を返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def testnml_to_s
if @testnml
@testnml.set_modname(@entity.mod_name)
@testnml.set_author(@entity.author)
@testnml.set_copyright(@entity.copyright)
@testnml.lang_ja = @entity.lang_ja
return @testnml.to_s
else
return ''
end
end
#
# テストプログラム実行用シェルスクリプトファイルの中身を返す.
# ただし, モジュール全体を生成する場合以外は空文字を返す.
#
def testsh_to_s
if @testsh
@testsh.set_modname(@entity.mod_name)
@testsh.set_author(@entity.author)
@testsh.set_copyright(@entity.copyright)
@testsh.lang_ja = @entity.lang_ja
return @testsh.to_s
else
return ''
end
end
#
# DCModelF90SampleMaker クラス内で使用する共通メソッドを用意.
#
module F90CodeChecker
#
# 第1引数 name が Fortran 90/95 ソースコードの言語要素として使用できる
# 名称かどうかをチェックする. 使用できる場合には true を, 使用できない場合
# には false を返す.
# 第2引数 raiseerror に true を与える場合, name が言語要素の名称として
# 不適切な場合, エラーを生じる.
#
def valid_f90entityname?(name, raiseerror=nil)
f90entityname = /^[A-Za-z][A-Za-z0-9_]*$/
unless name && name.to_s =~ f90entityname
if raiseerror
raise ArgumentError, " Error: \"#{name.to_s}\" is invalid for f90 entity name."
else
return false
end
end
return true
end
#
# 標準入力から F90 ソースコードの言語要素の名称を受け取る.
# 第1引数 defaultname にはデフォルト値を (無入力の場合はこれを受け取る),
# 第2引数には受け取る値の解説文を与える.
#
# 入力された値が不適切である場合, 何度も入力を求める.
#
def f90entityname_from_stdin(defaultname, keyword)
getname = ''
while !(valid_f90entityname?(getname))
print " Input #{keyword} [#{defaultname}]: "
getname = STDIN.gets.chomp
getname = defaultname if getname == ''
end
return getname
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (モジュール) の雛形となる
# コードを生成するためのクラス.
#
class DCModelF90SampleModuleMaker
include F90CodeChecker
attr_reader :mod_name, :mod_basename, :mod_arg_type, :mod_arg_keyword
attr_reader :author, :copyright
attr_accessor :lang_ja
def initialize(quiet=nil)
@mod_name = 'dcmodel_sample_code'
autoset_names
@quiet = quiet
@author = 'unknown'
@copyright = 'GFD Dennou Club'
@title = 'Title'
@title_ja = 'タイトル'
@lang_ja = true
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @mod_name.tr("A-Z","a-z") + '.f90'
end
def set_modname(modname)
valid_f90entityname?(modname, true)
@mod_name = modname.to_s
end
#
# @mod_name を元に, 自動的に手続きの名前のベースネームや
# 構造体名, 個々の手続き用の引数キーワード名を作成する.
# @mod_name はいくつかの単語 (小文字) をアンダーバーで繋いだ
# 文字列であることが仮定されている.
#
def autoset_names
return false unless @mod_name =~ /.+\_.+/
@mod_basename = ''
@mod_arg_type = ''
@mod_arg_keyword = ''
@mod_name.split('_').each{ |part|
@mod_basename << part.sub(/^./){|c| c.tr("a-z","A-Z")}
[part.length, 3].min.times{|i|
@mod_arg_type << part[i].chr.tr("a-z","A-Z")
@mod_arg_keyword << part[i].chr.tr("A-Z","a-z")
}
@mod_arg_keyword << '_'
}
@mod_arg_keyword.sub!(/\_+$/, '')
return true
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@mod_name = f90entityname_from_stdin(@mod_name, 'Module name')
autoset_names
print " Title of module (for English documentation) [#{@title}]: "
title = STDIN.gets.chomp
@title = title unless title == ''
if @lang_ja
print " Title of module (for Japanese documentation) [#{@title_ja}]: "
title_ja = STDIN.gets.chomp
@title_ja = title_ja unless title_ja == ''
end
@mod_basename = f90entityname_from_stdin(@mod_basename, 'basename')
@mod_arg_type = f90entityname_from_stdin(@mod_arg_type, 'arg_type')
if @mod_name == @mod_arg_type
raise ArgumentError,
"\n Error: Module name \"#{@mod_name}\" is equal to arg_type \"#{@mod_arg_type}\" ."
end
@mod_arg_keyword = f90entityname_from_stdin(@mod_arg_keyword, 'arg_keyword')
if @mod_name == @mod_arg_keyword
raise ArgumentError,
"\n Error: Module name \"#{@mod_name}\" is equal to arg_keyword \"#{@mod_arg_keyword}\" ."
elsif @mod_arg_type == @mod_arg_keyword
raise ArgumentError,
"\n Error: arg_type \"#{@mod_arg_type}\" is equal to arg_keyword \"#{@mod_arg_keyword}\" ."
end
print " Input Your name [#{@author}]: "
author = STDIN.gets.chomp
@author = author unless author == ''
print " Input Copyright [#{@copyright}]: "
copyright = STDIN.gets.chomp
@copyright = copyright unless copyright == ''
end
#
# F90 ソースコードを返す.
#
def to_s
str = ''
if @lang_ja
str << <<-EOF
!= #{@title_ja}
!
EOF
end
str << <<-EOF
!= #{@title}
!
! Authors:: #{@author}
! Version:: $#{}I#{}d: $
! Tag Name:: $#{}N#{}ame: $
! Copyright:: Copyright (C) #{@copyright}, #{Time.now.strftime("%Y")}. All rights reserved.
! License::
!
module #{@mod_name}
!
EOF
if @lang_ja
str << <<-EOF
!= #{@title_ja}
!
EOF
end
str << <<-EOF
!= #{@title}
!
EOF
if @lang_ja
str << <<-EOF
! Note that Japanese and English are described in parallel.
!
! モジュールに関する概説
!
EOF
end
str << <<-EOF
! Overview of Modules
!
!== Procedures List
!
EOF
if @lang_ja
str << <<-EOF
! Create :: #{@mod_arg_type} 型変数の初期設定
! Close :: #{@mod_arg_type} 型変数の終了処理
! PutLine :: #{@mod_arg_type} 型変数に格納されている情報の印字
! initialized :: #{@mod_arg_type} 型変数が初期設定されているか否か
! ------------ :: ------------
EOF
end
str << <<-EOF
! Create :: Constructor of "#{@mod_arg_type}"
! Close :: Deconstructor of "#{@mod_arg_type}"
! PutLine :: Print information of "#{@mod_arg_type}"
! initialized :: Check initialization of "#{@mod_arg_type}"
!
!== Usage
!
EOF
if @lang_ja
str << <<-EOF
! 始めに, #{@mod_arg_type} 型の変数を定義し, Create で初期設定を行います.
!--
! モジュールの利用法を記述してください.
!++
! #{@mod_arg_type} 型の変数の終了処理には Close を用いてください.
!
EOF
end
str << <<-EOF
! First, initialize "#{@mod_arg_type}" by Create.
!--
! Describe usage of module
!++
! In order to terminate "#{@mod_arg_type}", use Close.
!
use dc_types, only: DP, TOKEN
implicit none
private
public:: #{@mod_arg_type}, Create, Close, PutLine, initialized
EOF
typemake = DCModelF90SampleTypeMaker.new
typemake.lang_ja = @lang_ja
typemake.set_typename(@mod_arg_type)
str << typemake.to_s
str << "\n"
str << <<-EOF
character(*), parameter:: version = &
& '$Name: dcpam4-20070731-1 $' // &
& '$#{}I#{}d: $'
EOF
proc_list = ['create', 'close', 'putline', 'initialized', 'nmlread', 'other']
proc_list.each {|proc|
if !(proc == 'other') && !(proc == 'initialized')
proc_name = proc.sub(/^./){|c| c.tr("a-z","A-Z")}
proc_name = 'PutLine' if proc_name == 'Putline'
proc_name = 'NmlRead' if proc_name == 'Nmlread'
str << <<-EOF
interface #{proc_name}
module procedure #{@mod_basename}#{proc_name}
end interface
EOF
elsif proc == 'initialized'
proc_name = proc.sub(/^./){|c| c.tr("a-z","A-Z")}
str << <<-EOF
interface #{proc}
module procedure #{@mod_basename}#{proc_name}
end interface
EOF
else
proc_name = 'Sample'
str << <<-EOF
!!$ interface #{proc_name}
!!$ module procedure #{@mod_basename}#{proc_name}
!!$ end interface
EOF
end
}
str << <<-EOF
contains
EOF
proc_list.each {|proc|
procmake = DCModelF90SampleProcMaker.new(proc)
procmake.lang_ja = @lang_ja
procmake.set_modname(@mod_name)
procmake.set_basename(@mod_basename)
procmake.set_arg_type(@mod_arg_type)
procmake.set_arg_keyword(@mod_arg_keyword)
unless proc == 'other'
str << procmake.to_s
str << "\n"
else
procmake.set_operate_name('Sample')
str << procmake.to_s.gsub(/^/, '!!$')
str << "\n"
end
}
str << <<-EOF
end module #{@mod_name}
EOF
return str
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (構造型定義) の雛形となる
# コードを生成するためのクラス.
#
class DCModelF90SampleTypeMaker
include F90CodeChecker
attr_accessor :lang_ja
def initialize(quiet=nil)
@type_name = 'DCMSAMCOD'
@lang_ja = true
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @type_name.tr("A-Z","a-z") + '.f90'
end
def set_typename(typename)
valid_f90entityname?(typename, true)
@type_name = typename.to_s
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@type_name = f90entityname_from_stdin(@type_name, 'type_name')
end
#
# F90 ソースコードを返す.
#
def to_s
str = <<-EOF
type #{@type_name}
!
EOF
if @lang_ja
str << <<-EOF
! まず, Create で "#{@type_name}" 型の変数を初期設定して下さい.
! 初期設定された "#{@type_name}" 型の変数を再度利用する際には,
! Close によって終了処理を行ってください.
!
EOF
end
str << <<-EOF
! Initialize "#{@type_name}" variable by "Create" before usage.
! If you reuse "#{@type_name}" variable again for another application,
! terminate by "Close".
!
EOF
if @lang_ja
str << <<-EOF
logical:: initialized = .false. ! 初期設定フラグ.
! Initialization flag
EOF
else
str << <<-EOF
logical:: initialized = .false. ! Initialization flag
EOF
end
str << <<-EOF
!!$ integer:: param_i
!!$ real(DP):: param_r
!!$ character(TOKEN):: param_c
end type #{@type_name}
EOF
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (手続き) の雛形となる
# コードを生成するためのクラス.
#
class DCModelF90SampleProcMaker
include F90CodeChecker
attr_accessor :lang_ja
def initialize(kind='other', quiet=nil)
case kind
when 'create', 'close', 'putline', 'initialized', 'nmlread', 'other'
@kind = kind
else
raise ArgumentError, " Error: @kind = \"#{kind}\" is invalid."
end
case kind
when 'create', 'close', 'initialized'
@operate_name = kind.sub(/^./){|c| c.tr("a-z","A-Z")}
when 'putline'
@operate_name = 'PutLine'
when 'nmlread'
@operate_name = 'NmlRead'
else
@operate_name = 'Calculation'
end
@basename = 'DcmodelSampleCode'
@arg_type = 'DCMSAMCOD'
@arg_keyword = 'dcm_sam_cod'
@alreadyinit_err_code = 'DC_EALREADYINIT'
@noinit_err_code = 'DC_ENOTINIT'
@quiet = quiet
@lang_ja = true
@mod_name = 'dcmodel_sample_code' # used for 'nmlread'
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return (@basename + @operate_name).tr("A-Z","a-z") + '.f90'
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
case @kind
when 'nmlread'
@mod_name = f90entityname_from_stdin(@mod_name, 'modname')
end
@basename = f90entityname_from_stdin(@basename, 'basename')
@operate_name = f90entityname_from_stdin(@operate_name, 'operate_name')
@arg_type = f90entityname_from_stdin(@arg_type, 'arg_type')
@arg_keyword = f90entityname_from_stdin(@arg_keyword, 'arg_keyword')
@noinit_err_code = f90entityname_from_stdin(@noinit_err_code, 'noinit_err_code')
@alreadyinit_err_code = f90entityname_from_stdin(@alreadyinit_err_code, 'alreadyinit_err_code')
end
def set_modname(modname)
valid_f90entityname?(modname, true)
@mod_name = modname.to_s
end
def set_basename(basename)
valid_f90entityname?(basename, true)
@basename = basename.to_s
end
def set_operate_name(operate_name)
valid_f90entityname?(operate_name, true)
@operate_name = operate_name.to_s
end
def set_arg_type(arg_type)
valid_f90entityname?(arg_type, true)
@arg_type = arg_type.to_s
end
def set_arg_keyword(arg_keyword)
valid_f90entityname?(arg_keyword, true)
@arg_keyword = arg_keyword.to_s
end
def set_noinit_err_code(noinit_err_code)
valid_f90entityname?(noinit_err_code, true)
@noinit_err_code = noinit_err_code.to_s
end
def set_alreadyinit_err_code(alreadyinit_err_code)
valid_f90entityname?(alreadyinit_err_code, true)
@alreadyinit_err_code = alreadyinit_err_code.to_s
end
#
# F90 ソースコードを返す. 設定値が無効な場合, 空文字を返す.
#
def to_s
str = ''
case @kind
when 'create', 'close', 'putline', 'initialized', 'nmlread', 'other'
case @kind
when 'putline'
str = <<-EOF
subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, unit, indent, err )
EOF
when 'create'
str = <<-EOF
subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, &
!!$ & param_i, param_r, param_c, &
& nmlfile, err )
EOF
when 'nmlread'
str = <<-EOF
subroutine #{@basename}#{@operate_name}( nmlfile, &
!!$ & param_i, param_r, param_c_, &
& err )
EOF
when 'initialized'
str = <<-EOF
logical function #{@basename}#{@operate_name}( #{@arg_keyword} ) result(result)
EOF
else
str = <<-EOF
subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, err )
EOF
end
case @kind
when 'initialized'
str << <<-EOF
#{dc_default_documentation}
#{dc_default_declaration}
continue
#{dc_default_operate}
end function #{@basename}#{@operate_name}
EOF
else
str << <<-EOF
#{dc_default_documentation}
#{dc_default_declaration}
character(*), parameter:: subname = '#{@basename}#{@operate_name}'
continue
#{dc_default_preinit}
#{dc_default_initialize}
#{dc_default_operate}
#{dc_default_terminate}
end subroutine #{@basename}#{@operate_name}
EOF
end
else
return ''
end
return str
end
def dc_default_documentation
str = ''
case @kind
when 'create'
if @lang_ja
str << <<-EOF
!
! #{@arg_type} 型の変数の初期設定を行います.
! 他のサブルーチンを使用する前に必ずこのサブルーチンによって
! #{@arg_type} 型の変数を初期設定してください.
!
! なお, 与えられた *#{@arg_keyword}* が既に初期設定されている場合,
! プログラムはエラーを発生させます.
!
! NAMELIST を利用する場合には引数 *nmlfile* に NAMELIST ファイル名
! を与えてください.
EOF
end
str << <<-EOF
!
! Constructor of "#{@arg_type}".
! Initialize *#{@arg_keyword}* by this subroutine,
! before other procedures are used,
!
! Note that if *#{@arg_keyword}* is already initialized
! by this procedure, error is occurred.
!
! In order to use NAMELIST, specify a NAMELIST filename to
! argument *nmlfile*.
!
EOF
when 'close'
if @lang_ja
str << <<-EOF
!
! #{@arg_type} 型の変数の終了処理を行います.
! なお, 与えられた *#{@arg_keyword}* が Create によって初期設定
! されていない場合, プログラムはエラーを発生させます.
EOF
end
str << <<-EOF
!
! Deconstructor of "#{@arg_type}".
! Note that if *#{@arg_keyword}* is not initialized by Create yet,
! error is occurred.
!
EOF
when 'putline'
if @lang_ja
str << <<-EOF
!
! 引数 *#{@arg_keyword}* に設定されている情報を印字します.
! デフォルトではメッセージは標準出力に出力されます.
! *unit* に装置番号を指定することで, 出力先を変更することが可能です.
EOF
end
str << <<-EOF
!
! Print information of *#{@arg_keyword}*.
! By default messages are output to standard output.
! Unit number for output can be changed by *unit* argument.
!
EOF
when 'initialized'
if @lang_ja
str << <<-EOF
!
! *#{@arg_keyword}* が初期設定されている場合には .true. が,
! 初期設定されていない場合には .false. が返ります.
EOF
end
str << <<-EOF
!
! If *#{@arg_keyword}* is initialized, .true. is returned.
! If *#{@arg_keyword}* is not initialized, .false. is returned.
!
EOF
when 'nmlread'
if @lang_ja
str << <<-EOF
!
! NAMELIST ファイル *nmlfile* から値を入力するための
! 内部サブルーチンです. Create 内で呼び出されることを
! 想定しています.
!
! 値が NAMELIST ファイル内で指定されていない場合には,
! 入力された値がそのまま返ります.
!
! なお, *nmlfile* に空文字が与えられた場合, または
! 与えられた *nmlfile* を読み込むことができない場合,
! プログラムはエラーを発生させます.
EOF
end
str << <<-EOF
!
! This is an internal subroutine to input values from
! NAMELIST file *nmlfile*. This subroutine is expected to be
! called by "Create".
!
! A value not specified in NAMELIST file is returned
! without change.
!
! If *nmlfile* is empty, or *nmlfile* can not be read,
! error is occurred.
!
EOF
else
if @lang_ja
str << <<-EOF
!--
! #{@basename}#{@operate_name} の要約を記述してください.
!++
! なお, 与えられた *#{@arg_keyword}* が Create によって初期設定
! されていない場合, プログラムはエラーを発生させます.
EOF
end
str << <<-EOF
!--
! Describe brief of #{@basename}#{@operate_name}
!++
! If *#{@arg_keyword}* is not initialized by Create yet,
! error is occurred.
!
EOF
end
return str.chomp
end
def dc_default_declaration
case @kind
when 'initialized'
str = <<-EOF
implicit none
type(#{@arg_type}), intent(in):: #{@arg_keyword}
EOF
return str.chomp
end
str = <<-EOF
use dc_trace, only: BeginSub, EndSub
use dc_types, only: DP, STRING, TOKEN, STDOUT
EOF
case @kind
when 'create'
str << <<-EOF
use dc_present, only: present_and_not_empty, present_and_true
use dc_message, only: MessageNotify
use dc_error, only: StoreError, DC_NOERR, #{@alreadyinit_err_code}, &
& DC_EARGLACK, DC_ENEGATIVE, DC_ENOFILEREAD
EOF
when 'nmlread'
str << <<-EOF
use dc_iounit, only: FileOpen
use dc_message, only: MessageNotify
use dc_present, only: present_and_true
use dc_error, only: StoreError, DC_NOERR, DC_ENOFILEREAD
EOF
else
str << <<-EOF
use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code}
EOF
end
case @kind
when 'putline'
str << <<-EOF
use dc_string, only: Printf
EOF
end
str << <<-EOF
implicit none
EOF
case @kind
when 'putline'
str << <<-EOF
type(#{@arg_type}), intent(in):: #{@arg_keyword}
EOF
when 'nmlread'
else
str << <<-EOF
type(#{@arg_type}), intent(inout):: #{@arg_keyword}
EOF
end
case @kind
when 'create'
str << <<-EOF
!!$ integer, intent(in):: param_i
!!$ real(DP), intent(in), optional:: param_r
!!$ character(*), intent(in), optional:: param_c
character(*), intent(in), optional :: nmlfile
EOF
if @lang_ja
str << <<-EOF
! NAMELIST ファイルの名称.
! この引数に空文字以外を与えた場合,
! 指定されたファイルから
! NAMELIST 変数群を読み込みます.
! ファイルを読み込めない場合にはエラーを
! 生じます.
!
EOF
end
str << <<-EOF
! NAMELIST file name.
! If nonnull character is specified to
! this argument,
! NAMELIST group name is loaded from the
! file.
! If the file can not be read,
! an error occurs.
!
EOF
when 'putline'
str << <<-EOF
integer, intent(in), optional:: unit
EOF
if @lang_ja
str << <<-EOF
! 出力先の装置番号.
! デフォルトの出力先は標準出力.
!
EOF
end
str << <<-EOF
! Unit number for output.
! Default value is standard output.
character(*), intent(in), optional:: indent
EOF
if @lang_ja
str << <<-EOF
! 表示されるメッセージの字下げ.
!
EOF
end
str << <<-EOF
! Indent of displayed messages.
EOF
when 'nmlread'
str << <<-EOF
character(*), intent(in):: nmlfile
EOF
if @lang_ja
str << <<-EOF
! NAMELIST ファイルの名称.
EOF
end
str << <<-EOF
! NAMELIST file name
!!$ integer, intent(inout):: param_i
!!$ real(DP), intent(inout):: param_r
!!$ character(*), intent(inout):: param_c_
!!$ character(TOKEN):: param_c
EOF
end
str << <<-EOF
logical, intent(out), optional:: err
EOF
if @lang_ja
str << <<-EOF
! 例外処理用フラグ.
! デフォルトでは, この手続き内でエラーが
! 生じた場合, プログラムは強制終了します.
! 引数 *err* が与えられる場合,
! プログラムは強制終了せず, 代わりに
! *err* に .true. が代入されます.
!
EOF
end
str << <<-EOF
! Exception handling flag.
! By default, when error occur in
! this procedure, the program aborts.
! If this *err* argument is given,
! .true. is substituted to *err* and
! the program does not abort.
EOF
case @kind
when 'nmlread'
str << <<-EOF
!!$ namelist /#{@mod_name}_nml/ &
!!$ & param_i, param_r, param_c
EOF
if @lang_ja
str << <<-EOF
! #{@mod_name} モジュール用
! NAMELIST 変数群名.
!
EOF
end
str << <<-EOF
! NAMELIST group name for
! '#{@mod_name}' module.
EOF
when 'other'
str << <<-EOF
!!$ integer:: param_i
!!$ real(DP):: param_r
!!$ character(STRING):: param_c
EOF
end
str << <<-EOF
!-----------------------------------
EOF
if @lang_ja
str << <<-EOF
! 作業変数
EOF
end
str << <<-EOF
! Work variables
integer:: stat
character(STRING):: cause_c
EOF
case @kind
when 'putline'
str << <<-EOF
integer:: out_unit
integer:: indent_len
character(STRING):: indent_str
EOF
when 'nmlread'
if @lang_ja
str << <<-EOF
integer:: unit_nml ! NAMELIST ファイルオープン用装置番号.
! Unit number for NAMELIST file open
integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT.
! IOSTAT of NAMELIST read
EOF
else
str << <<-EOF
integer:: unit_nml ! Unit number for NAMELIST file open
integer:: iostat_nml ! IOSTAT of NAMELIST read
EOF
end
end
return str.chomp
end
def dc_default_preinit
case @kind
when 'initialized'
return ''
end
case @kind
when 'create'
str = <<-EOF
call BeginSub( subname, version )
EOF
else
str = <<-EOF
call BeginSub( subname )
EOF
end
str << <<-EOF
stat = DC_NOERR
cause_c = ''
EOF
return str.chomp
end
def dc_default_initialize
case @kind
when 'initialized'
return ''
end
case @kind
when 'nmlread'
str = ""
else
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 初期設定のチェック
EOF
end
str << <<-EOF
! Check initialization
!-----------------------------------------------------------------
EOF
end
case @kind
when 'create'
str << <<-EOF
if ( #{@arg_keyword} % initialized ) then
stat = #{@alreadyinit_err_code}
cause_c = '#{@arg_type}'
goto 999
end if
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 引数の正当性のチェック
EOF
end
str << <<-EOF
! Validate arguments
!-----------------------------------------------------------------
!!$ if ( .not. present(param_r) .and. .not. present(param_c) ) then
!!$ stat = DC_EARGLACK
!!$ cause_c = '"param_r" or "param_c"'
!!$ goto 999
!!$ end if
EOF
when 'putline'
str << <<-EOF
if ( present(unit) ) then
out_unit = unit
else
out_unit = STDOUT
end if
indent_len = 0
indent_str = ''
if ( present(indent) ) then
if ( len(indent) /= 0 ) then
indent_len = len(indent)
indent_str(1:indent_len) = indent
end if
end if
EOF
when 'nmlread'
else
str << <<-EOF
if ( .not. #{@arg_keyword} % initialized ) then
stat = #{@noinit_err_code}
cause_c = '#{@arg_type}'
goto 999
end if
EOF
end
return str.chomp
end
def dc_default_operate
case @kind
when 'create'
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! "#{@arg_type}" の設定
EOF
end
str << <<-EOF
! Configure the settings for "#{@arg_type}"
!-----------------------------------------------------------------
!-------------------------
EOF
if @lang_ja
str << <<-EOF
! デフォルト値
EOF
end
str << <<-EOF
! Default values
!!$ #{@arg_keyword} % param_r = 0.0_DP
!!$ #{@arg_keyword} % param_c = 'hogehoge'
!-------------------------
EOF
if @lang_ja
str << <<-EOF
! オプショナル引数からの値
EOF
end
str << <<-EOF
! Values from optional arguments
!!$ #{@arg_keyword} % param_i = param_i
!!$ if ( present(param_r) ) #{@arg_keyword} % param_r = param_r
!!$ if ( present(param_c) ) #{@arg_keyword} % param_c = param_c
!-------------------------
EOF
if @lang_ja
str << <<-EOF
! NAMELIST からの値
EOF
end
str << <<-EOF
! Values from NAMELIST
!!$ if ( present_and_not_empty(nmlfile) ) then
!!$ call MessageNotify( 'M', subname, &
!!$ & 'Loading NAMELIST file "%c" ...', &
!!$ & c1=trim(nmlfile) )
!!$ call NmlRead ( nmlfile = nmlfile, & ! (in)
!!$ & param_i = #{@arg_keyword} % param_i, & ! (inout)
!!$ & param_r = #{@arg_keyword} % param_r, & ! (inout)
!!$ & param_c_ = #{@arg_keyword} % param_c, & ! (inout)
!!$ & err = err ) ! (out)
!!$ if ( present_and_true(err) ) then
!!$ call MessageNotify( 'W', subname, &
!!$ & '"%c" can not be read.', &
!!$ & c1=trim(nmlfile) )
!!$ stat = DC_ENOFILEREAD
!!$ cause_c = nmlfile
!!$ goto 999
!!$ end if
!!$ end if
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 設定値の正当性のチェック
EOF
end
str << <<-EOF
! Validate setting values
!-----------------------------------------------------------------
!!$ if ( #{@arg_keyword} % param_i < 0 ) then
!!$ stat = DC_ENEGATIVE
!!$ cause_c = 'param_i'
!!$ goto 999
!!$ end if
EOF
when 'close'
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! "#{@arg_type}" の設定の消去
EOF
end
str << <<-EOF
! Clear the settings for "#{@arg_type}"
!-----------------------------------------------------------------
EOF
when 'putline'
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! "#{@arg_type}" の設定の印字
EOF
end
str << <<-EOF
! Print the settings for "#{@arg_type}"
!-----------------------------------------------------------------
EOF
str << <<-EOF
if ( #{@arg_keyword} % initialized ) then
call Printf(out_unit, &
& indent_str(1:indent_len) // &
& '#<#{@arg_type}:: @initialized=%y', &
& l=(/#{@arg_keyword} % initialized/))
!!$ call Printf(out_unit, &
!!$ & indent_str(1:indent_len) // &
!!$ & ' @param_i=%d @param_r=%f @param_c=%c', &
!!$ & i=(/#{@arg_keyword} % param_i/), &
!!$ & d=(/#{@arg_keyword} % param_r/), &
!!$ & c1=trim(#{@arg_keyword} % param_c) )
call Printf(out_unit, &
& indent_str(1:indent_len) // &
& '>' )
else
call Printf(out_unit, &
& indent_str(1:indent_len) // &
& '#<#{@arg_type}:: @initialized=%y>', &
& l=(/#{@arg_keyword} % initialized/))
end if
EOF
when 'initialized'
str = <<-EOF
result = #{@arg_keyword} % initialized
EOF
when 'nmlread'
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 文字型引数を NAMELIST 変数群へ代入
EOF
end
str << <<-EOF
! Substitute character arguments to NAMELIST group
!-----------------------------------------------------------------
!!$ param_c = param_c_
!----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! NAMELIST ファイルのオープン
EOF
end
str << <<-EOF
! Open NAMELIST file
!----------------------------------------------------------------
call FileOpen( unit = unit_nml, & ! (out)
& file = nmlfile, mode = 'r', & ! (in)
& err = err ) ! (out)
if ( present_and_true(err) ) then
stat = DC_ENOFILEREAD
cause_c = nmlfile
goto 999
end if
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! NAMELIST 変数群の取得
EOF
end
str << <<-EOF
! Get NAMELIST group
!-----------------------------------------------------------------
!!$ read( unit = unit_nml, & ! (in)
!!$ & nml = #{@mod_name}_nml, iostat = iostat_nml ) ! (out)
!!$ if ( iostat_nml == 0 ) then
!!$ call MessageNotify( 'M', subname, &
!!$ & 'NAMELIST group "%c" is loaded from "%c".', &
!!$ & c1='#{@mod_name}_nml', c2=trim(nmlfile) )
!!$ write(STDOUT, nml = #{@mod_name}_nml)
!!$ else
!!$ call MessageNotify( 'W', subname, &
!!$ & 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', &
!!$ & c1='#{@mod_name}_nml', c2=trim(nmlfile), &
!!$ & i=(/iostat_nml/) )
!!$ end if
close( unit_nml )
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! NAMELIST 変数群を文字型引数へ代入
EOF
end
str << <<-EOF
! Substitute NAMELIST group to character arguments
!-----------------------------------------------------------------
!!$ param_c_ = param_c
EOF
else
str = <<-EOF
!-----------------------------------------------------------------
! *#{@arg_keyword}* に格納されている設定値の取り出し
! Fetch setting values stored in *#{@arg_keyword}*
!-----------------------------------------------------------------
!!$ param_i = #{@arg_keyword} % param_i
!!$ param_r = #{@arg_keyword} % param_r
!!$ param_c = #{@arg_keyword} % param_c
EOF
end
return str.chomp
end
def dc_default_terminate
case @kind
when 'initialized'
return ""
end
str = <<-EOF
!-----------------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 終了処理, 例外処理
EOF
end
str << <<-EOF
! Termination and Exception handling
!-----------------------------------------------------------------
EOF
case @kind
when 'create'
str << <<-EOF
#{@arg_keyword} % initialized = .true.
EOF
when 'close'
str << <<-EOF
#{@arg_keyword} % initialized = .false.
EOF
end
str << <<-EOF
999 continue
call StoreError( stat, subname, err, cause_c )
call EndSub( subname )
EOF
return str.chomp
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (モジュール) のテストプログラムの雛形となる
# コードを生成するためのクラス.
#
class DCModelF90SampleTestMaker
include F90CodeChecker
attr_accessor :lang_ja
def initialize(quiet=nil)
@mod_name = 'dcmodel_sample_code'
@program_name = @mod_name + '_test'
autoset_names
@quiet = quiet
@author = 'unknown'
@copyright = 'GFD Dennou Club'
@lang_ja = true
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @program_name + '.f90'
end
def set_modname(modname)
valid_f90entityname?(modname, true)
@mod_name = modname.to_s
@program_name = @mod_name + '_test'
end
def set_programname(programname)
valid_f90entityname?(programname, true)
@program_name = programname.to_s
end
def set_basename(basename)
valid_f90entityname?(basename, true)
@mod_basename = basename.to_s
end
def set_arg_type(arg_type)
valid_f90entityname?(arg_type, true)
@mod_arg_type = arg_type.to_s
end
def set_arg_keyword(arg_keyword)
valid_f90entityname?(arg_keyword, true)
@mod_arg_keyword = arg_keyword.to_s
end
def set_author(author)
@author = author
end
def set_copyright(copyright)
@copyright = copyright
end
#
# @mod_name を元に, 自動的に手続きの名前のベースネームや
# 構造体名, 個々の手続き用の引数キーワード名を作成する.
# @mod_name はいくつかの単語 (小文字) をアンダーバーで繋いだ
# 文字列であることが仮定されている.
#
def autoset_names
return false unless @mod_name =~ /.+\_.+/
@mod_basename = ''
@mod_arg_type = ''
@mod_arg_keyword = ''
@mod_name.split('_').each{ |part|
@mod_basename << part.sub(/^./){|c| c.tr("a-z","A-Z")}
[part.length, 3].min.times{|i|
@mod_arg_type << part[i].chr.tr("a-z","A-Z")
@mod_arg_keyword << part[i].chr.tr("A-Z","a-z")
}
@mod_arg_keyword << '_'
}
@mod_arg_keyword.sub!(/\_+$/, '')
return true
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@mod_name = f90entityname_from_stdin(@mod_name, 'Module name')
autoset_names
@mod_basename = f90entityname_from_stdin(@mod_basename, 'basename')
@mod_arg_type = f90entityname_from_stdin(@mod_arg_type, 'arg_type')
@mod_arg_keyword = f90entityname_from_stdin(@mod_arg_keyword, 'arg_keyword')
print " Input Your name [#{@author}]: "
author = STDIN.gets.chomp
@author = author unless author == ''
print " Input Copyright [#{@copyright}]: "
copyright = STDIN.gets.chomp
@copyright = copyright unless copyright == ''
end
def to_s
str = ''
if @lang_ja
str << <<-EOF
!= #{@mod_name} モジュールのテストプログラム
!
EOF
end
str << <<-EOF
!= Test program for "#{@mod_name}"
!
! Authors:: #{@author}
! Version:: $#{}I#{}d: $
! Tag Name:: $#{}N#{}ame: $
! Copyright:: Copyright (C) #{@copyright}, #{Time.now.strftime("%Y")}. All rights reserved.
! License::
!
EOF
if @lang_ja
str << <<-EOF
! Note that Japanese and English are described in parallel.
!
! #{@mod_name} モジュールの動作テストを行うためのプログラムです.
! このプログラムがコンパイルできること, および実行時に
! プログラムが正常終了することを確認してください.
!
EOF
end
str << <<-EOF
! This program checks the operation of "#{@mod_name}" module.
! Confirm compilation and execution of this program.
!
program #{@program_name}
use #{@mod_name}, only: #{@mod_arg_type}, Create, Close, &
& PutLine, initialized
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
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 実験の表題, モデルの名称, 所属機関名
EOF
end
str << <<-EOF
! Title of a experiment, name of model, sub-organ
!---------------------------------------------------------
character(*), parameter:: title = &
& '#{@program_name} $Name: dcpam4-20070731-1 $ :: ' // &
& 'Test program of "#{@mod_name}" module'
character(*), parameter:: source = &
& 'dcmodel project: hierarchical numerical models ' // &
& '(See http://www.gfd-dennou.org/library/dcmodel)'
character(*), parameter:: institution = &
& 'GFD Dennou Club (See http://www.gfd-dennou.org)'
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 作業変数
EOF
end
str << <<-EOF
! Work variables
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
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
EOF
else
str << <<-EOF
type(ARGS):: arg ! Command line arguments
logical:: OPT_namelist ! Existence of '-N', '--namelist' option
character(TOKEN):: VAL_namelist
! Value of '-N', '--namelist' option
EOF
end
str << <<-EOF
type(#{@mod_arg_type}):: #{@mod_arg_keyword}00, #{@mod_arg_keyword}01, #{@mod_arg_keyword}02, #{@mod_arg_keyword}03
logical:: err
continue
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! コマンドライン引数の処理
EOF
end
str << <<-EOF
! Command line arguments handling
!---------------------------------------------------------
call Open( arg )
call HelpMsg( arg, 'Title', title )
call HelpMsg( arg, 'Usage', &
& './#{@program_name} [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 )
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 初期設定テスト
EOF
end
str << <<-EOF
! Initialization test
!---------------------------------------------------------
call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 & ! (inout)
!!$ & , param_i = 256, param_r = 98.7_DP & ! (in)
& )
call AssertEqual( 'initialization test 1', &
& answer = .true., check = initialized(#{@mod_arg_keyword}00) )
call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in)
call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}00, & ! (inout)
!!$ & param_i = 256, param_r = 98.7_DP, & ! (in)
& err = err ) ! (out)
call AssertEqual( 'initialization test 2', &
& answer = .true., check = err )
call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in)
call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}01, & ! (inout)
!!$ & param_i = 256, param_r = 98.7_DP, & ! (in)
& nmlfile = VAL_namelist ) ! (in)
call AssertEqual( 'initialization test 3 (NAMELIST)', &
& answer = .true., check = initialized(#{@mod_arg_keyword}01) )
call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}01 ) ! (in)
!!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}02, & ! (inout)
!!$ & param_i = -32, param_r = 0.5_DP, param_c = 'foo', & ! (in)
!!$ & err = err ) ! (out)
!!$ call AssertEqual( 'initialization test 4', &
!!$ & answer = .true., check = err )
!!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}02, & ! (inout)
!!$ & param_i = 256, & ! (in)
!!$ & err = err ) ! (out)
!!$ call AssertEqual( 'initialization test 5', &
!!$ & answer = .true., check = err )
!!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout)
!!$ & param_i = -32, param_r = 0.5_DP, param_c = 'foo', & ! (in)
!!$ & nmlfile = VAL_namelist ) ! (in)
!!$ call AssertEqual( 'initialization test 6 (NAMELIST)', &
!!$ & answer = .true., check = initialized(#{@mod_arg_keyword}03) )
!!$ call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}03 ) ! (in)
!---------------------------------------------------------
EOF
if @lang_ja
str << <<-EOF
! 終了処理テスト
EOF
end
str << <<-EOF
! Termination test
!---------------------------------------------------------
call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (inout)
call AssertEqual( 'termination test 1', &
& answer = .false., check = initialized(#{@mod_arg_keyword}00) )
call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in)
call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}02, & ! (inout)
& err = err ) ! (out)
call AssertEqual( 'termination test 2', &
& answer = .true., check = err )
end program #{@program_name}
EOF
return str
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (モジュール) のテストプログラム用
# NAMELIST ファイルの雛形となるコードを生成するためのクラス.
#
class DCModelF90SampleTestNmlMaker
include F90CodeChecker
attr_accessor :lang_ja
def initialize(quiet=nil)
@mod_name = 'dcmodel_sample_code'
@program_name = @mod_name + '_test'
@nml_group_name = @mod_name + '_nml'
@quiet = quiet
@author = 'unknown'
@copyright = 'GFD Dennou Club'
@lang_ja = true
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @program_name + '00.nml'
end
def set_modname(modname)
valid_f90entityname?(modname, true)
@mod_name = modname.to_s
@program_name = @mod_name + '_test'
end
def set_programname(programname)
valid_f90entityname?(programname, true)
@program_name = programname.to_s
end
def set_author(author)
@author = author
end
def set_copyright(copyright)
@copyright = copyright
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@mod_name = f90entityname_from_stdin(@mod_name, 'Module name')
print " Input Your name [#{@author}]: "
author = STDIN.gets.chomp
@author = author unless author == ''
print " Input Copyright [#{@copyright}]: "
copyright = STDIN.gets.chomp
@copyright = copyright unless copyright == ''
end
def to_s
str = ''
if @lang_ja
str << <<-EOF
#= #{@mod_name} モジュールのテストプログラム用 NAMELIST ファイル
#
EOF
end
str << <<-EOF
#= NAMELIST file for test program of "#{@mod_name}"
#
# Authors:: #{@author}
# Version:: $#{}I#{}d: $
# Tag Name:: $#{}N#{}ame: $
# Copyright:: Copyright (C) #{@copyright}, #{Time.now.strftime("%Y")}. All rights reserved.
# License::
#
EOF
str << <<-EOF
{@mod_name}_nml
param_i=123,
param_r=9872.0,
param_c='herohero'
/
EOF
return str
end
end
#
# {dcmodel プログラミングガイドライン}[http://www.gfd-dennou.org/library/dcmodel/coding-rules/dcmodel-coding-rules.htm]に基づく
# Fortran 90/95 ソースコード (モジュール) のテストプログラム実行用
# シェルスクリプトの雛形となるコードを生成するためのクラス.
#
class DCModelF90SampleTestShMaker
include F90CodeChecker
attr_accessor :lang_ja
def initialize(quiet=nil)
@mod_name = 'dcmodel_sample_code'
@program_name = @mod_name + '_test'
@quiet = quiet
@author = 'unknown'
@copyright = 'GFD Dennou Club'
@lang_ja = true
end
#
# ファイル名としてふさわしい名前を返す.
#
def filename
return @program_name + '.sh'
end
def set_modname(modname)
valid_f90entityname?(modname, true)
@mod_name = modname.to_s
@program_name = @mod_name + '_test'
end
def set_programname(programname)
valid_f90entityname?(programname, true)
@program_name = programname.to_s
end
def set_author(author)
@author = author
end
def set_copyright(copyright)
@copyright = copyright
end
#
# このメソッドを呼び出すと, コマンドライン上で
# インタラクティブに設定が行われる.
#
def interactive_setup
@mod_name = f90entityname_from_stdin(@mod_name, 'Module name')
@program_name = @mod_name + '_test'
print " Input Your name [#{@author}]: "
author = STDIN.gets.chomp
@author = author unless author == ''
print " Input Copyright [#{@copyright}]: "
copyright = STDIN.gets.chomp
@copyright = copyright unless copyright == ''
end
def to_s
str = ''
str << <<-EOF
#!/bin/sh
#
#= Compile and Execute test program of "#{@mod_name}"
#
# Authors:: #{@author}
# Version:: $#{}I#{}d: $
# Tag Name:: $#{}N#{}ame: $
# Copyright:: Copyright (C) #{@copyright}, #{Time.now.strftime("%Y")}. All rights reserved.
# License::
#
######################################################################
#
#== Settings
test -n "$TEST_BASE" || TEST_BASE="#{@mod_name}"
TEST_OBJ="${TEST_BASE}.f90 ${TEST_BASE}_test.f90"
TEST_EXEC="${TEST_BASE}_test"
TEST_NML00="${TEST_BASE}_test00.nml"
test -n "$LINKF" || LINKF=gt4frt
#test -n "$MAKE" || MAKE=make
# End Settings
######################################################################
set -e
case `echo "testing\\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
*c*,-n*) ECHO_N= ECHO_C='
' ECHO_T=' ' ;;
*c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
*) ECHO_N= ECHO_C='\\c' ECHO_T= ;;
esac
echo ""
echo "****** ${TEST_BASE} Test ******"
echo " in \\"`pwd`\\""
echo " Compiling and Linking ... "
if [ -n "${LINKF}" ]; then
echo " ${LINKF} ${TEST_OBJ} -o ${TEST_EXEC}"
${LINKF} ${TEST_OBJ} -o ${TEST_EXEC}
else
${MAKE} ${TEST_EXEC}
fi
echo " done . "
if [ ! "$CROSS_COMPILING" = "yes" ] && [ ! "$CROSS_COMPILING" = "maybe" ] ; then
echo "./${TEST_EXEC} --namelist=${TEST_NML00}"
./${TEST_EXEC} --namelist=${TEST_NML00}
else
echo ""
echo " WARNING: Cross compile mode will be used."
echo " Submit ./${TEST_EXEC} ."
echo ""
exit 1
fi
echo " *** Test program \\"${TEST_EXEC}\\" becomes successful ***"
exit 0
EOF
return str
end
end
end
#
# 以下はこのファイルを実行プログラムとして動かした際の動作.
#
if $0 == __FILE__
opt = OptionParser.new
OPTS = {}
ARGV.options{|opt|
opt.on( '-E=VAL', '--entity=VAL',
"kind of entity (ex. \"module\", \"procedure\")"
){|v| OPTS[:entity] = v.gsub(/^=/, '')}
opt.on( '-K=VAL', '--proc-kind=VAL',
"kind of procedure
(ex. \"create\", \"close\",
\"putline\", \"nmlread\")
\"other\")"
){|v| OPTS[:proc_kind] = v.gsub(/^=/, '')}
opt.on( '-i', '--interactive',
"interactive setup (default)"
){|v| OPTS[:interactive] = v}
opt.on( '-f', '--overwrite',
"Overwrite existing files"
){|v| OPTS[:overwrite] = v}
opt.on( '--stdout',
"Output to standard output"
){|v| OPTS[:stdout] = v}
opt.on( '--stdout-test',
"Output test program to standard output (only entity = module)"
){|v| OPTS[:stdout_test] = v}
opt.on( '-o=VAL', '--output=VAL',
"Output to specified file
(default: .f90, or
.f90)"
){|v| OPTS[:output] = v.gsub(/^=/, '')}
opt.on( '--no-lang-ja',
"Japanese documents are not output"
){|v| OPTS[:no_lang_ja] = v}
opt.on( '--no-test',
"Test program is not output"
){|v| OPTS[:no_test] = v}
opt.on_tail('-q', '--quiet',
"non interactive setup"
){|v| OPTS[:quiet] = v}
opt.on_tail('-h', '-H', '--help',
"This help message is output"
){|v| OPTS[:help] = v}
opt.parse!
}
if OPTS[:help] || !(OPTS[:entity])
print <<-"EOF"
#{File.basename($0.to_s)}:
USAGE: #{File.basename($0.to_s)} -E=kind_of_entity [options]
OPTION: \n#{opt.to_a[1..-1].join("")}
EOF
exit
end
OPTS[:proc_kind] ||= 'other'
dcf90sample = DCModelF90SampleMaker.new(OPTS[:entity], OPTS[:proc_kind], OPTS[:quiet])
if OPTS[:no_lang_ja]
dcf90sample.no_lang_ja
end
if OPTS[:interactive] || !(OPTS[:quiet])
dcf90sample.interactive_setup
end
if OPTS[:stdout_test]
print dcf90sample.test_to_s
elsif OPTS[:stdout]
print dcf90sample.to_s
else
ofile = OPTS[:output] || dcf90sample.filename
if File.exist?(ofile) && !(OPTS[:overwrite])
raise IOError, "\n Error: \"#{ofile}\" already exists.\n" +
" Remove \"#{ofile}\" or use option \"--overwrite\"\n"
end
STDOUT.print " Message: #{ofile} is generated ... "
File.open(ofile, 'w'){ |file|
file.puts(dcf90sample.to_s)
}
STDOUT.print "done.\n"
if OPTS[:entity] == 'module' && !(OPTS[:no_test])
if OPTS[:output]
if OPTS[:output] =~ /(\.f\d*)$/i
testfilebase = $~.pre_match
testfilesuffix = $1
else
testfilebase = OPTS[:output]
testfilesuffix = ''
end
testfilename = testfilebase + '_test' + testfilesuffix
testnmlfilename = testfilebase + '_test00.nml'
testshfilename = testfilebase + '_test.sh'
end
otestfile = testfilename || dcf90sample.test_filename
otestnmlfile = testnmlfilename || dcf90sample.testnml_filename
otestshfile = testshfilename || dcf90sample.testsh_filename
if File.exist?(otestfile) && !(OPTS[:overwrite])
raise IOError, "\n Error: \"#{otestfile}\" already exists.\n" +
" Remove \"#{otestfile}\" or use option \"--overwrite\"\n"
end
if File.exist?(otestnmlfile) && !(OPTS[:overwrite])
raise IOError, "\n Error: \"#{otestnmlfile}\" already exists.\n" +
" Remove \"#{otestnmlfile}\" or use option \"--overwrite\"\n"
end
if File.exist?(otestshfile) && !(OPTS[:overwrite])
raise IOError, "\n Error: \"#{otestshfile}\" already exists.\n" +
" Remove \"#{otestshfile}\" or use option \"--overwrite\"\n"
end
STDOUT.print " Message: #{otestfile} is generated ... "
File.open(otestfile, 'w'){ |file|
file.puts(dcf90sample.test_to_s)
}
STDOUT.print "done.\n"
STDOUT.print " Message: #{otestnmlfile} is generated ... "
File.open(otestnmlfile, 'w'){ |file|
file.puts(dcf90sample.testnml_to_s)
}
STDOUT.print "done.\n"
STDOUT.print " Message: #{otestshfile} is generated ... "
File.open(otestshfile, 'w'){ |file|
file.puts(dcf90sample.testsh_to_s)
}
STDOUT.print "done.\n"
end
end
end