#!/usr/bin/env ruby # #= Fortran 90/95 dcmodel sample code maker # #Authors:: Yasuhiro MORIKAWA #Version:: $Id: dcmodel_f90sample_maker.rb,v 1.75 2008-06-01 16:07:39 morikawa Exp $ #Tag Name:: $Name: dcpam4-20080624-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='sample', 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 @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_arg_type == @mod_arg_keyword raise ArgumentError, "\n Error: arg_type \"#{@mod_arg_type}\" is equal to arg_keyword \"#{@mod_arg_keyword}\" ." # elsif @mod_name == @mod_arg_keyword # raise ArgumentError, # "\n Error: Module name \"#{@mod_name}\" 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 = '' str << <<-EOF != #{@title_ja} ! != #{@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} ! != #{@title_ja} ! != #{@title} ! ! Note that Japanese and English are described in parallel. ! ! モジュールに関する概説 ! ! Overview of Modules ! !== Procedures List ! ! #{@mod_basename}Create :: #{@mod_arg_type} 型変数の初期設定 ! #{@mod_basename}Calculation :: 演算 ! #{@mod_basename}Close :: #{@mod_arg_type} 型変数の終了処理 ! #{@mod_basename}PutLine :: #{@mod_arg_type} 型変数に格納されている情報の印字 ! #{@mod_basename}initialized :: #{@mod_arg_type} 型変数が初期設定されているか否か ! #{@mod_basename}SetTime :: 時刻の設定 ! ------------ :: ------------ ! #{@mod_basename}Create :: Constructor of "#{@mod_arg_type}" ! #{@mod_basename}Calculation :: Calculation ! #{@mod_basename}Close :: Deconstructor of "#{@mod_arg_type}" ! #{@mod_basename}PutLine :: Print information of "#{@mod_arg_type}" ! #{@mod_basename}initialized :: Check initialization of "#{@mod_arg_type}" ! #{@mod_basename}SetTime :: Configure time ! !== Usage ! ! 始めに, #{@mod_arg_type} 型の変数を定義し, ! #{@mod_basename}Create で初期設定を行います. !-- ! モジュールの利用法を記述してください. !++ ! #{@mod_arg_type} 型の変数の終了処理には ! #{@mod_basename}Close を用いてください. ! ! First, initialize "#{@mod_arg_type}" by "#{@mod_basename}Create". !-- ! Describe usage of module !++ ! In order to terminate "#{@mod_arg_type}", use "#{@mod_basename}Close". ! use dc_types, only: DP, TOKEN, STRING use dc_date_types, only: DC_DIFFTIME use gt4_history_nmlinfo, only: GTHST_NMLINFO implicit none private public:: #{@mod_arg_type} public:: #{@mod_basename}Create, #{@mod_basename}Calculation public:: #{@mod_basename}Close, #{@mod_basename}PutLine public:: #{@mod_basename}Initialized, #{@mod_basename}SetTime EOF typemake = DCModelF90SampleTypeMaker.new typemake.lang_ja = @lang_ja typemake.set_typename(@mod_arg_type) typemake.set_modname(@mod_name) typemake.set_basename(@mod_basename) str << typemake.to_s str << "\n" str << <<-EOF character(*), parameter:: version = & & '$Name: dcpam4-20080624-1 $' // & & '$#{}I#{}d: $' EOF str << <<-EOF !----------------------------------------------------------------- ! 公開手続 ! Public procedures !----------------------------------------------------------------- EOF proc_public_list = ['create', 'calc', 'sample', 'close', 'putline', 'initialized', 'settime'] proc_private_list = ['nmlread'] proc_public_list.each {|proc| if !(proc == 'initialized') && !(proc == 'sample') proc_name = proc.sub(/^./){|c| c.tr("a-z","A-Z")} proc_name = 'PutLine' if proc_name == 'Putline' proc_name = 'SetTime' if proc_name == 'Settime' proc_name = 'Calculation' if proc_name == 'Calc' str << <<-EOF interface #{@mod_basename}#{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")} proc_name = 'Initialized' str << <<-EOF interface #{@mod_basename}#{proc} module procedure #{@mod_basename}#{proc_name} end interface EOF elsif proc == 'sample' proc_name = 'Sample' str << <<-EOF !!$ interface #{@mod_basename}#{proc_name} !!$ module procedure #{@mod_basename}#{proc_name} !!$ end interface EOF end } str << <<-EOF !----------------------------------------------------------------- ! 非公開手続 ! Private procedures !----------------------------------------------------------------- EOF proc_private_list.each {|proc| if !(proc == 'sample') proc_name = proc.sub(/^./){|c| c.tr("a-z","A-Z")} proc_name = 'NmlRead' if proc_name == 'Nmlread' str << <<-EOF interface #{proc_name} module procedure #{@mod_basename}#{proc_name} end interface EOF else proc_name = 'Sample' str << <<-EOF !!$ interface #{@mod_basename}#{proc_name} !!$ module procedure #{@mod_basename}#{proc_name} !!$ end interface EOF end } str << <<-EOF contains EOF proc_list = proc_public_list + proc_private_list 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 == 'sample' 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 if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end 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 = 'DCSMPLCODE' @lang_ja = true @mod_name = 'dcmodel_sample_code' # used for '***_HISTNML' type 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 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 interactive_setup @type_name = f90entityname_from_stdin(@type_name, 'type_name') end # # F90 ソースコードを返す. # def to_s str = <<-EOF type #{@type_name} ! ! まず, #{@basename}Create で "#{@type_name}" 型の ! 変数を初期設定して下さい. ! 初期設定された "#{@type_name}" 型の変数を再度利用する際には, ! #{@basename}Close によって終了処理を行ってください. ! ! Initialize "#{@type_name}" variable by ! "#{@basename}Create" before usage. ! If you reuse "#{@type_name}" variable again for another application, ! terminate by "#{@basename}Close". ! logical:: initialized = .false. ! 初期設定フラグ. ! Initialization flag !----------------------------------------------------------------- ! 格子点数・最大全波数 ! Grid points and maximum truncated wavenumber !----------------------------------------------------------------- !!$ integer:: imax ! 経度格子点数. !!$ ! Number of grid points in longitude !!$ integer:: jmax ! 緯度格子点数. !!$ ! Number of grid points in latitude !----------------------------------------------------------------- ! 軸データ ! Axes data !----------------------------------------------------------------- !!$ real(DP), pointer:: x_Lon (:) =>null() !!$ ! 経度. Longitude !!$ real(DP), pointer:: y_Lat (:) =>null() !!$ ! 緯度. Latitude !----------------------------------------------------------------- ! 係数 ! Coefficients !----------------------------------------------------------------- !!$ real(DP):: CoefAlpha ! $ \\alpha $ . 係数. Coefficient !----------------------------------------------------------------- ! 文字データ ! Character data !----------------------------------------------------------------- !!$ character(TOKEN):: key00 ! キーワード. Keyword !!$ !----------------------------------------------------------------- ! 時刻管理 ! Time control !----------------------------------------------------------------- type(DC_DIFFTIME):: current_time ! 現在時刻. Current time. type(DC_DIFFTIME):: delta_time ! $ \\Delta t $ . タイムステップ. Time step !----------------------------------------------------------------- ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output !----------------------------------------------------------------- type(GTHST_NMLINFO):: gthstnml ! NAMELIST\##{@mod_name}_history_nml ! から入手される個別のデータ出力情報. ! ! Individual data output information from ! "NAMELIST\##{@mod_name}_history_nml". end type #{@type_name} EOF if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end 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='sample', quiet=nil) case kind when 'create', 'close', 'putline', 'initialized', 'settime', 'calc', 'nmlread', 'sample' @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 'settime' @operate_name = 'SetTime' when 'calc' @operate_name = 'Calculation' when 'nmlread' @operate_name = 'NmlRead' else @operate_name = 'Sample' 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', 'settime', 'calc', 'nmlread', 'sample' 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}, & !!$ & imax, jmax, & !!$ & x_Lon, y_Lat, & !!$ & CoefAlpha, DelTime, & & current_time_value, current_time_unit, & & history_varlist, & & history_interval_value, history_interval_unit, & & history_precision, history_fileprefix, & & nmlfile, err ) EOF when 'initialized' str = <<-EOF logical function #{@basename}#{@operate_name}( #{@arg_keyword} ) result(result) EOF when 'settime' str = <<-EOF subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, & & current_time_value, current_time_unit, & & err ) EOF when 'calc' str = <<-EOF subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, & !!$ & x_Data1, y_Data2, & & historyput_flag, & & err ) EOF when 'nmlread' str = <<-EOF subroutine #{@basename}#{@operate_name}( nmlfile, & !!$ & CoefAlpha, & !!$ & key00_, & & gthstnml, & & err ) 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} #{dc_default_internal_procedures} end subroutine #{@basename}#{@operate_name} EOF end else return '' end if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end end def dc_default_documentation str = '' case @kind when 'create' str << <<-EOF ! ! #{@arg_type} 型の変数の初期設定を行います. ! 他のサブルーチンを使用する前に必ずこのサブルーチンによって ! #{@arg_type} 型の変数を初期設定してください. ! ! なお, 与えられた *#{@arg_keyword}* が既に初期設定されている場合, ! プログラムはエラーを発生させます. ! ! NAMELIST を利用する場合には引数 *nmlfile* に NAMELIST ファイル名 ! を与えてください. NAMELIST 変数群の詳細に関しては ! NAMELIST\##{@mod_name}_nml を参照してください. ! ! 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*. See "NAMELIST\##{@mod_name}_nml" ! for details about a NAMELIST group. ! EOF when 'close' str << <<-EOF ! ! #{@arg_type} 型の変数の終了処理を行います. ! なお, 与えられた *#{@arg_keyword}* が #{@basename}Create ! によって初期設定されていない場合, プログラムはエラーを発生させます. ! ! Deconstructor of "#{@arg_type}". ! Note that if *#{@arg_keyword}* is not initialized ! by "#{@basename}Create" yet, error is occurred. ! EOF when 'putline' str << <<-EOF ! ! 引数 *#{@arg_keyword}* に設定されている情報を印字します. ! デフォルトではメッセージは標準出力に出力されます. ! *unit* に装置番号を指定することで, 出力先を変更することが可能です. ! ! 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' str << <<-EOF ! ! *#{@arg_keyword}* が初期設定されている場合には .true. が, ! 初期設定されていない場合には .false. が返ります. ! ! If *#{@arg_keyword}* is initialized, .true. is returned. ! If *#{@arg_keyword}* is not initialized, .false. is returned. ! EOF when 'settime' str << <<-EOF ! ! *#{@arg_keyword}* に対して時刻の設定を行います. ! ! ヒストリデータを出力している場合には, ! ヒストリデータの出力時刻も設定します. ! 一度でもこのサブルーチンを呼んだ場合には, ! それ以後のヒストリデータ出力前にこのサブルーチンを呼び出し, ! 時刻の設定を行ってください. ! また, データを出力するサブルーチンに対しても ! オプショナル引数 historyput_flag に .true. を与えてください. ! ! なお, 与えられた *#{@arg_keyword}* が #{@basename}Create ! によって初期設定されていない場合, プログラムはエラーを発生させます. ! ! Set time to *#{@arg_keyword}*. ! ! When history data are output, ! the output time of history data are specified. ! Once this subroutine is called, the time of history data must be ! specified by this routine before history data output. ! In additional, give ".true." to an optional argument ! "historyput_flag" of a data output subroutine. ! ! If *#{@arg_keyword}* is not initialized ! by "#{@basename}Create" yet, error is occurred. ! EOF when 'calc' str << <<-EOF ! ! *x_Data1* と *y_Data2* に対して演算を行い, 変更された値を返します. ! 計算後, *#{@arg_keyword}* 内の時刻を更新します. ! ! なお, 与えられた *#{@arg_keyword}* が #{@basename}Create ! によって初期設定されていない場合, プログラムはエラーを発生させます. ! ! Calculate *x_Data1* and *y_Data2*, and return changed values. ! After the calculation, time stored in *#{@arg_keyword}* is updated. ! ! If *#{@arg_keyword}* is not initialized ! by "#{@basename}Create" yet, error is occurred. ! EOF when 'nmlread' str << <<-EOF ! ! NAMELIST ファイル *nmlfile* から値を入力するための ! サブルーチンです. #{@basename}Create ! 内で呼び出されることを想定しています. ! ! 値が NAMELIST ファイル内で指定されていない場合には, ! 入力された値がそのまま返ります. ! ! なお, *nmlfile* に空文字が与えられた場合, または ! 与えられた *nmlfile* を読み込むことができない場合, ! プログラムはエラーを発生させます. ! ! This is a subroutine to input values from ! NAMELIST file *nmlfile*. This subroutine is expected to be ! called by "#{@basename}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 str << <<-EOF !-- ! #{@basename}#{@operate_name} の要約を記述してください. !++ ! なお, 与えられた *#{@arg_keyword}* が #{@basename}Create ! によって初期設定されていない場合, プログラムはエラーを発生させます. !-- ! Describe brief of "#{@basename}#{@operate_name}". !++ ! If *#{@arg_keyword}* is not initialized ! by "#{@basename}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_string, only: PutLine, Printf, Split, StrInclude, StoA, JoinChar 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, & & present_select use dc_message, only: MessageNotify use dc_error, only: StoreError, DC_NOERR, #{@alreadyinit_err_code}, & & DC_EARGLACK, DC_ENEGATIVE, DC_ENOFILEREAD, USR_ERRNO, HST_EBADVARNAME use dc_date, only: DCDiffTimeCreate use dc_hash, only: HASH, DCHashPut, DCHashRewind, DCHashNext, DCHashDelete use gt4_history_nmlinfo, only: HstNmlInfoCreate, HstNmlInfoAdd, & & HstNmlInfoEndDefine, HstNmlInfoPutLine, HstNmlInfoAllNameValid use gt4_history, only: GT_HISTORY, & & HistoryAddVariable, HistoryAddAttr EOF when 'calc' str << <<-EOF use dc_present, only: present_and_true use dc_date, only: mod, operator(+), operator(==), EvalbyUnit, EvalSec use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code}, USR_ERRNO use gt4_history_nmlinfo, only: HstNmlInfoInquire, & & HstNmlInfoOutputValid, HstNmlInfoAssocGtHist, HstNmlInfoPutLine use gt4_history, only: GT_HISTORY, HistoryPut, HistoryInitialized EOF when 'close' str << <<-EOF use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history_nmlinfo, only: HstNmlInfoClose, HstNmlInfoNames, & & HstNmlInfoAssocGtHist, HstNmlInfoPutLine use gt4_history, only: GT_HISTORY, HistoryClose, HistoryInitialized EOF when 'putline' str << <<-EOF use dc_date, only: EvalSec use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history_nmlinfo, only: GTHST_NMLINFO, HstNmlInfoPutLine EOF when 'settime' str << <<-EOF use dc_date, only: DCDiffTimeCreate, EvalbyUnit use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history_nmlinfo, only: HstNmlInfoAdd, HstNmlInfoInquire, & & HstNmlInfoNames, HstNmlInfoAssocGtHist, & & HstNmlInfoOutputStepDisable, HstNmlInfoPutLine use gt4_history, only: GT_HISTORY, HistorySetTime, HistoryInitialized EOF when 'nmlread' str << <<-EOF use dc_iounit, only: FileOpen use dc_message, only: MessageNotify use dc_present, only: present_and_true use dc_date, only: DCDiffTimeCreate use dc_error, only: StoreError, DC_NOERR, DC_ENOFILEREAD, #{@noinit_err_code} use gt4_history_nmlinfo, only: GTHST_NMLINFO, HstNmlInfoAdd, & & HstNmlInfoInquire, HstNmlInfoInitialized, HstNmlInfoPutLine EOF else str << <<-EOF use dc_date, only: EvalSec use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} 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):: imax !!$ ! 経度格子点数. !!$ ! Number of grid points in longitude !!$ integer, intent(in):: jmax !!$ ! 緯度格子点数. !!$ ! Number of grid points in latitude !!$ real(DP), intent(in):: x_Lon (0:imax-1) !!$ ! 経度. Longitude !!$ real(DP), intent(in):: y_Lat (0:jmax-1) !!$ ! 緯度. Latitude !!$ real(DP), intent(in):: CoefAlpha !!$ ! $ \\alpha $ . 係数. Coefficient !!$ real(DP), intent(in):: DelTime !!$ ! $ \\Delta t $ . タイムステップ. Time step real, intent(in), optional:: current_time_value ! 現在時刻の数値. Numerical value of current time character(*), intent(in), optional:: current_time_unit ! 現在時刻の単位. Unit of current time character(*), intent(in), optional:: history_varlist ! ヒストリデータの出力変数リスト. ! カンマで区切って並べる. ! (例: "Data1,Data2" ). ! ! List of variables output to history data. ! Delimiter is comma. ! (exp. "Data1,Data2" ). ! real, intent(in), optional:: history_interval_value ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output character(*), intent(in), optional:: history_interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(*), intent(in), optional:: history_precision ! ヒストリデータの精度. ! Precision of history data character(*), intent(in), optional:: history_fileprefix ! ヒストリデータのファイル名の接頭詞. ! Prefix of history data filenames character(*), intent(in), optional:: nmlfile ! NAMELIST ファイルの名称. ! この引数に空文字以外を与えた場合, ! 指定されたファイルから ! NAMELIST 変数群を読み込みます. ! ファイルを読み込めない場合にはエラーを ! 生じます. ! ! NAMELIST 変数群の詳細に関しては ! NAMELIST\##{@mod_name}_nml ! を参照してください. ! ! 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. ! ! See "NAMELIST\##{@mod_name}_nml" ! for details about a NAMELIST group. ! EOF when 'putline' str << <<-EOF integer, intent(in), optional:: unit ! 出力先の装置番号. ! デフォルトの出力先は標準出力. ! ! Unit number for output. ! Default value is standard output. character(*), intent(in), optional:: indent ! 表示されるメッセージの字下げ. ! ! Indent of displayed messages. EOF when 'settime' str << <<-EOF real, intent(in):: current_time_value ! 現在時刻の数値. Numerical value of current time character(*), intent(in):: current_time_unit ! 現在時刻の単位. Unit of current time EOF when 'calc' str << <<-EOF !!$ real(DP), intent(inout):: x_Data1 (0:#{@arg_keyword}%imax-1) !!$ ! データ 1. Data 1 !!$ real(DP), intent(inout):: y_Data2 (0:#{@arg_keyword}%jmax-1) !!$ ! データ 2. Data 2 logical, intent(in), optional:: historyput_flag ! データ出力のフラグ. ! SetTime によって時刻を明示的に ! 指定した場合には, この引数に ! .true. または .false. を指定する ! ことでデータ出力のオンオフを ! 明示的に指定する必要があります. ! デフォルトは .false. です. ! ! Data output flag. ! When time is specified by "SetTime", ! explicit specification of data output ! on/off by specifying ".true." or ".false." ! to this argument. ! Default value is ".false.". ! EOF when 'nmlread' str << <<-EOF character(*), intent(in):: nmlfile ! NAMELIST ファイルの名称. ! NAMELIST file name !!$ real(DP), intent(inout):: CoefAlpha !!$ ! $ \\alpha $ . 係数. Coefficient !!$ !!$ character(*), intent(inout):: key00_ !!$ character(TOKEN):: key00 !!$ ! キーワード. Keyword !!$ type(GTHST_NMLINFO), intent(inout):: gthstnml ! NAMELIST\##{@mod_name}_history_nml ! から入手される個別のデータ出力情報. ! ! 初期設定やデフォルト値の設定などを ! 行った後に与えること. ! ! Individual data output information from ! "NAMELIST\##{@mod_name}_history_nml". ! ! Before this argument is given to ! this procedure, initialize and ! configure the defaut settings. EOF end str << <<-EOF logical, intent(out), optional:: err ! 例外処理用フラグ. ! デフォルトでは, この手続き内でエラーが ! 生じた場合, プログラムは強制終了します. ! 引数 *err* が与えられる場合, ! プログラムは強制終了せず, 代わりに ! *err* に .true. が代入されます. ! ! 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 'calc', 'sample' str << <<-EOF !----------------------------------- ! *#{@arg_keyword}* から取り出される設定値 ! Setting values fetched from *#{@arg_keyword}* !!$ real(DP):: CoefAlpha ! $ \\alpha $ . 係数. Coefficient !!$ real(DP):: DelTime ! $ \\Delta t $ . タイムステップ. Time step EOF when 'nmlread' str << <<-EOF !!$ namelist /#{@mod_name}_nml/ & !!$ & CoefAlpha, key00 !!$ ! #{@mod_name} モジュール用 !!$ ! NAMELIST 変数群名. !!$ ! !!$ ! #{@mod_name}\##{@basename}Create !!$ ! を使用する際に, オプショナル引数 *nmlfile* !!$ ! へ NAMELIST ファイル名を指定することで, !!$ ! そのファイルからこの NAMELIST 変数群を !!$ ! 読み込みます. !!$ ! !!$ ! NAMELIST group name for !!$ ! "#{@mod_name}" module. !!$ ! !!$ ! If a NAMELIST filename is specified to !!$ ! an optional argument *nmlfile* when !!$ ! "#{@mod_name}\##{@basename}Create" !!$ ! is used, this NAMELIST group is !!$ ! loaded from the file. character(STRING):: name ! 変数名. ! 空白の場合には, この他の設定値は ! #{@mod_name} モジュールにおいて ! 出力されるデータ全ての ! デフォルト値となります. ! ! "Data1,Data2" のようにカンマで区切って複数 ! の変数を指定することも可能です. ! ! Variable identifier. ! If blank is given, other values are ! used as default values of output data ! in "#{@mod_name}". ! ! Multiple variables can be specified ! as "Data1,Data2" too. Delimiter is comma. character(STRING):: file ! 出力ファイル名. ! これはデフォルト値としては使用されません. ! *name* に値が設定されている時のみ有効です. ! ! Output file name. ! This is not used as default value. ! This value is valid only when *name* is ! specified. real:: interval_value ! ヒストリデータの出力間隔の数値. ! 負の値を与えると, 出力を抑止します. ! Numerical value for interval of history data output ! Negative values suppresses output. character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(TOKEN):: precision ! ヒストリデータの精度. ! Precision of history data logical:: average ! 出力データの平均化フラグ. ! Flag for average of output data character(STRING):: fileprefix ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames namelist /#{@mod_name}_history_nml/ & & name, & & file, & & interval_value, & & interval_unit, & & precision, & & fileprefix, & & average ! #{@mod_name} モジュールのヒストリデータ用 ! NAMELIST 変数群名. ! ! #{@mod_name}\##{@basename}Create ! を使用する際に, オプショナル引数 *nmlfile* ! へ NAMELIST ファイル名を指定することで, ! そのファイルからこの NAMELIST 変数群を ! 読み込みます. ! ! NAMELIST group name for ! history data of "#{@mod_name}" module. ! ! If a NAMELIST filename is specified to ! an optional argument *nmlfile* when ! "#{@mod_name}\##{@basename}Create" ! is used, this NAMELIST group is ! loaded from the file. EOF end case @kind when 'create', 'close', 'settime', 'calc' str << <<-EOF !----------------------------------- ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output character(STRING):: name = '' ! 変数名. Variable identifier EOF end case @kind when 'create' str << <<-EOF character(STRING):: longname = '' ! 変数の記述的名称. Descriptive name of variables character(STRING), allocatable:: dims(:) ! 座標軸の名称. Name of axes character(STRING):: units = '' ! 単位. Units type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module character(TOKEN):: precision ! ヒストリデータの精度. ! Precision of history data logical:: average ! 出力データの平均化フラグ. ! Flag for average of output data type(HASH):: registered_varnames ! このモジュールから出力される変数名のリスト. ! ! List of names of variables output ! from this module. logical:: hash_end ! HASH オブジェクトの終了フラグ. ! ! End flag of "HASH" object logical:: allvar_invalid ! 無効な変数名のチェックフラグ. ! ! Check flag of invalid variable names character(STRING):: names_invalid ! 無効な変数名. ! ! Invalid variable names character(STRING):: nmlfile_msg ! NAMELIST ファイル名に関するメッセージ. ! ! Messages about NAMELIST file name EOF when 'close' str << <<-EOF character(STRING):: varnames ! 変数名リスト. ! List of variables character(TOKEN), pointer:: varnames_array(:) =>null() ! 変数名リスト配列. ! List of variables (array) integer:: i, vnmax type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module EOF when 'settime' str << <<-EOF character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output character(STRING):: varnames ! 変数名リスト. ! List of variables character(TOKEN), pointer:: varnames_array(:) =>null() ! 変数名リスト配列. ! List of variables (array) integer:: i, vnmax type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module EOF when 'calc' str << <<-EOF real:: time ! 時刻. Time type(GT_HISTORY), pointer:: gthist =>null() ! gt4_history モジュール用構造体. ! Derived type for "gt4_history" module 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' str << <<-EOF integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read character(TOKEN):: pos_nml ! NAMELIST 読み込み時のファイル位置. ! File position of NAMELIST read EOF 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 'putline' str = <<-EOF !----------------------------------------------------------------- ! 出力先装置番号と字下げの設定 ! Configure output unit number and indents !----------------------------------------------------------------- EOF else 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 !----------------------------------------------------------------- ! 引数の正当性のチェック ! Validate arguments !----------------------------------------------------------------- !!$ if (imax < 1) then !!$ stat = DC_ENEGATIVE !!$ cause_c = 'imax' !!$ goto 999 !!$ end if !!$ if (jmax < 1) then !!$ stat = DC_ENEGATIVE !!$ cause_c = 'jmax' !!$ goto 999 !!$ end if !!$ if (DelTime < 0.0_DP) then !!$ stat = DC_ENEGATIVE !!$ cause_c = 'DelTime' !!$ 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 !----------------------------------------------------------------- ! 波数・格子点の設定 ! Configure wave number and grid point !----------------------------------------------------------------- !!$ #{@arg_keyword} % imax = imax !!$ #{@arg_keyword} % jmax = jmax !----------------------------------------------------------------- ! 座標軸の設定 ! Configure axes !----------------------------------------------------------------- !!$ allocate( #{@arg_keyword} % x_Lon (0:imax-1) ) !!$ #{@arg_keyword} % x_Lon = x_Lon !!$ !!$ allocate( #{@arg_keyword} % y_Lat (0:jmax-1) ) !!$ #{@arg_keyword} % y_Lat = y_Lat !----------------------------------------------------------------- ! 時刻管理 ! Time control !----------------------------------------------------------------- !!$ if ( present(current_time_value) .and. present(current_time_unit) ) then !!$ call DCDiffTimeCreate( & !!$ & diff = #{@arg_keyword} % current_time, & ! (out) !!$ & value = real( current_time_value, DP ), & ! (in) !!$ & unit = current_time_unit ) ! (in) !!$ else !!$ call DCDiffTimeCreate( & !!$ & diff = #{@arg_keyword} % current_time, & ! (out) !!$ & value = 0.0_DP, & ! (in) !!$ & unit = 'sec' ) ! (in) !!$ end if !!$ !!$ call DCDiffTimeCreate( & !!$ & diff = #{@arg_keyword} % delta_time, & ! (out) !!$ & value = DelTime, & ! (in) !!$ & unit = 'sec' ) ! (in) !----------------------------------------------------------------- ! "#{@arg_type}" の設定 ! Configure the settings for "#{@arg_type}" !----------------------------------------------------------------- !!$ #{@arg_keyword} % CoefAlpha = CoefAlpha !!$ #{@arg_keyword} % key00 = '' !----------------------------------------------------------------- ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output !----------------------------------------------------------------- !------------------------- ! デフォルト値 ! Default values call HstNmlInfoCreate( gthstnml = #{@arg_keyword} % gthstnml ) ! (inout) !------------------------- ! オプショナル引数からの値 ! Values from optional arguments call HstNmlInfoAdd( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (inout) & name = '', & ! (in) & interval_value = history_interval_value, & ! (in) & interval_unit = history_interval_unit, & ! (in) & precision = history_precision, & ! (in) & average = .false., & ! (in) & fileprefix = history_fileprefix ) ! (in) if ( present(history_varlist) ) then call HstNmlInfoAdd( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (inout) & name = history_varlist ) ! (in) end if !----------------------------------------------------------------- ! NAMELIST からの値の読み込み ! Load 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) !!$ & CoefAlpha = #{@arg_keyword} % CoefAlpha, & ! (inout) !!$ & key00_ = #{@arg_keyword} % key00, & ! (inout) & gthstnml = #{@arg_keyword} % gthstnml, & ! (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 call HstNmlInfoEndDefine( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (inout) & err = err ) ! (out) if ( present_and_true( err ) ) then stat = USR_ERRNO goto 999 end if !----------------------------------------------------------------- ! データ出力の初期設定 ! Initialize data output !----------------------------------------------------------------- !!$ !------------------------- !!$ ! x_Data1 の出力設定 !!$ ! Configure the settings for "x_Data1" output !!$ name = 'Data1' !!$ longname = 'Sample data (1)' !!$ units = '1' !!$ allocate( dims(2) ) !!$ dims = StoA( 'lon', 'time' ) !!$ !!$ ! 出力ファイルの初期設定. !!$ ! * gthist (gt4_history#GT_HISTORY) が設定される. !!$ ! Initialize output file. !!$ ! * "gthist" (gt4_history#GT_HISTORY) is configured. !!$ call output_init ! これは内部サブルーチン. This is an internal subroutine !!$ !!$ ! 属性の付加などを行う場合には以下のようにする. !!$ ! Describe codes as follows in order to add attributes etc. !!$ if ( associated( gthist ) ) then !!$ call HistoryAddAttr( & !!$ & history = gthist, & ! (inout) !!$ & varname = name, attrname = 'missing_value', & ! (in) !!$ & value = 9999.0 ) ! (in) !!$ end if !!$ deallocate( dims ) !!$ !!$ !------------------------- !!$ ! y_Data2 の出力設定 !!$ ! Configure the settings for "y_Data2" output !!$ name = 'Data2' !!$ longname = 'Sample data (2)' !!$ units = '1' !!$ allocate( dims(2) ) !!$ dims = StoA( 'lat', 'time' ) !!$ !!$ ! 出力ファイルの初期設定. !!$ ! * gthist (gt4_history#GT_HISTORY) が設定される. !!$ ! Initialize output file. !!$ ! * "gthist" (gt4_history#GT_HISTORY) is configured. !!$ call output_init ! これは内部サブルーチン. This is an internal subroutine !!$ deallocate( dims ) !----------------------------------------------------------------- ! このモジュールから出力される変数名のリストを表示 ! Print list of names of variables output from this module !----------------------------------------------------------------- call Printf( STDOUT, & & ' *** MESSAGE *** +---- "%c" module output varnames list -----', & & c1 = '#{@mod_name}' ) call DCHashRewind( hashv = registered_varnames ) ! (inout) do call DCHashNext( hashv = registered_varnames, & ! (inout) & key = name, value = longname, end = hash_end ) ! (out) if ( hash_end ) exit call Printf( STDOUT, & & ' *** MESSAGE *** | "%c" (%c)', & & c1 = trim(name), c2 = trim(longname) ) enddo call DCHashDelete( hashv = registered_varnames ) ! (inout) call Printf( STDOUT, & & ' *** MESSAGE *** `----------------------------------------' ) !----------------------------------------------------------------- ! 無効な変数名のチェック ! Check invalid variable names !----------------------------------------------------------------- call HstNmlInfoAllNameValid( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (inout) & invalid = allvar_invalid, names = names_invalid, & ! (out) & err = err ) ! (out) if ( allvar_invalid ) then stat = HST_EBADVARNAME cause_c = names_invalid #{@arg_keyword} % initialized = .true. call #{@basename}Close( #{@arg_keyword}, & ! (inout) & err = err ) ! (out) if ( present(nmlfile) ) then nmlfile_msg = ' or NAMELIST "#{@mod_name}_history_nml" in "'// trim(nmlfile) // '"' else nmlfile_msg = '' end if call MessageNotify( 'W', subname, & & 'names "%c" from an optional argument "history_varlist"%c are invalid.', & & c1 = trim(names_invalid), & & c2 = trim(nmlfile_msg) ) goto 999 end if !----------------------------------------------------------------- ! 設定値の正当性のチェック ! Validate setting values !----------------------------------------------------------------- !!$ if ( #{@arg_keyword} % CoefAlpha < 0.0_DP ) then !!$ stat = DC_ENEGATIVE !!$ cause_c = 'CoefAlpha' !!$ goto 999 !!$ end if EOF when 'calc' str = <<-EOF !----------------------------------------------------------------- ! *#{@arg_keyword}* に格納されている設定値の取り出し ! Fetch setting values stored in *#{@arg_keyword}* !----------------------------------------------------------------- !!$ CoefAlpha = #{@arg_keyword} % CoefAlpha !!$ DelTime = EvalSec( #{@arg_keyword} % delta_time ) !----------------------------------------------------------------- ! 時間変化の演算 ! Calculate tendency !----------------------------------------------------------------- !!$ x_Data1 = ( 1.0_DP - CoefAlpha * DelTime ) * x_Data1 !!$ y_Data2 = ( 1.0_DP - CoefAlpha * DelTime ) * y_Data2 !---------------------------------------------------------------- ! ヒストリファイルへのデータ出力 ! History data output !---------------------------------------------------------------- !!$ !----------------------------------- !!$ ! x_Data1 の出力 !!$ ! Output "x_Data1" !!$ name = 'Data1' !!$ !!$ ! 出力のチェック. !!$ ! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される. !!$ ! Check for output. !!$ ! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured. !!$ call output_check ! これは内部サブルーチン. This is an internal subroutine !!$ !!$ ! 出力データを引数 array に渡す. !!$ ! Give output data to argument "array" !!$ if ( associated( gthist ) ) then !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = name, array = x_Data1, & ! (in) !!$ & time = time, quiet = .false., & ! (in) !!$ & err = err ) ! (out) !!$ end if !!$ !!$ !----------------------------------- !!$ ! y_Data2 の出力 !!$ ! Output "y_Data2" !!$ name = 'Data2' !!$ !!$ ! 出力のチェック. !!$ ! * gthist (gt4_history#GT_HISTORY), time (単精度実数型) が設定される. !!$ ! Check for output. !!$ ! * "gthist" (gt4_history#GT_HISTORY), time (real) are configured. !!$ call output_check ! これは内部サブルーチン. This is an internal subroutine !!$ !!$ ! 出力データを引数 array に渡す. !!$ ! Give output data to argument "array" !!$ if ( associated( gthist ) ) then !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = name, array = y_Data2, & ! (in) !!$ & time = time, quiet = .false., & ! (in) !!$ & err = err ) ! (out) !!$ end if !----------------------------------------------------------------- ! 時刻の更新 ! Update time !----------------------------------------------------------------- !!$ #{@arg_keyword} % current_time = & !!$ & #{@arg_keyword} % current_time + #{@arg_keyword} % delta_time EOF when 'close' str = <<-EOF !----------------------------------------------------------------- ! "#{@arg_type}" の設定の消去 ! Clear the settings for "#{@arg_type}" !----------------------------------------------------------------- !!$ deallocate( #{@arg_keyword} % x_Lon ) !!$ deallocate( #{@arg_keyword} % y_Lat ) !----------------------------------------------------------------- ! ヒストリファイルへのデータ出力の終了処理 ! Terminate the settings for history data output !----------------------------------------------------------------- varnames = HstNmlInfoNames( #{@arg_keyword} % gthstnml ) call Split( str = varnames, sep = ',', & ! (in) & carray = varnames_array ) ! (out) vnmax = size( varnames_array ) do i = 1, vnmax name = varnames_array(i) if ( trim( name ) == '' ) exit nullify( gthist ) call HstNmlInfoAssocGtHist( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & history = gthist, & ! (out) & err = err ) ! (out) if ( HistoryInitialized( gthist ) ) then call HistoryClose( history = gthist, & ! (inout) & err = err ) ! (out) end if end do !----------------------------------------------------------------- ! ヒストリファイルへのデータ出力設定の割付解除 ! Deallocate the settings for history data output !----------------------------------------------------------------- call HstNmlInfoClose( & & #{@arg_keyword} % gthstnml, & ! (inout) & err = err ) ! (out) EOF when 'putline' str = <<-EOF !----------------------------------------------------------------- ! "#{@arg_type}" の設定の印字 ! Print the settings for "#{@arg_type}" !----------------------------------------------------------------- if ( #{@arg_keyword} % initialized ) then call Printf( unit = out_unit, & ! (in) & fmt = indent_str(1:indent_len) // & & '#<#{@arg_type}:: @initialized=%y', & ! (in) & l = (/ #{@arg_keyword} % initialized /) ) ! (in) !!$ call Printf( unit = out_unit, & ! (in) !!$ & fmt = indent_str(1:indent_len) // & ! (in) !!$ & ' @imax=%d @jmax=%d', & ! (in) !!$ & i = (/ #{@arg_keyword} % imax, #{@arg_keyword} % jmax /) ) ! (in) !!$ !!$ call Printf( unit = out_unit, & ! (in) !!$ & fmt = indent_str(1:indent_len) // & !!$ & ' @current_time=%f [sec] @delta_time=%f [sec]', & ! (in) !!$ & d = (/ EvalSec( #{@arg_keyword} % current_time ), & !!$ & EvalSec( #{@arg_keyword} % delta_time ) /) ) ! (in) !!$ !!$ call Printf( unit = out_unit, & ! (in) !!$ & fmt = indent_str(1:indent_len) // & !!$ & ' @CoefAlpha=%f', & ! (in) !!$ & d = (/#{@arg_keyword} % CoefAlpha/) ) ! (in) !!$ !!$ call Printf( unit = out_unit, & ! (in) !!$ & fmt = indent_str(1:indent_len) // & !!$ & ' @key00=%c', & ! (in) !!$ & c1 = trim( #{@arg_keyword} % key00 ) ) ! (in) !!$ !!$ call PutLine( array = #{@arg_keyword} % x_Lon, & ! (in) !!$ & unit = out_unit, & ! (in) !!$ & lbounds = lbound(#{@arg_keyword} % x_Lon), & ! (in) !!$ & ubounds = ubound(#{@arg_keyword} % x_Lon), & ! (in) !!$ & indent = indent_str(1:indent_len) // & !!$ & ' @x_Lon=' ) ! (in) !!$ !!$ call PutLine( array = #{@arg_keyword} % y_Lat, & ! (in) !!$ & unit = out_unit, & ! (in) !!$ & lbounds = lbound(#{@arg_keyword} % y_Lat), & ! (in) !!$ & ubounds = ubound(#{@arg_keyword} % y_Lat), & ! (in) !!$ & indent = indent_str(1:indent_len) // & !!$ & ' @y_Lat=' ) ! (in) !!$ call Printf( unit = out_unit, & ! (in) & fmt = indent_str(1:indent_len) // & & ' @gthstnml=' ) ! (in) call HstNmlInfoPutLine( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & unit = out_unit, & ! (in) & indent = indent_str(1:indent_len) // ' ' ) ! (in) call Printf( unit = out_unit, & ! (in) & fmt = indent_str(1:indent_len) // '>' ) ! (in) else call Printf( unit = out_unit, & ! (in) & fmt = indent_str(1:indent_len) // & ! (in) & '#<#{@arg_type}:: @initialized=%y>', & ! (in) & l = (/#{@arg_keyword} % initialized/) ) ! (in) end if EOF when 'initialized' str = <<-EOF result = #{@arg_keyword} % initialized EOF when 'settime' str = <<-EOF !----------------------------------------------------------------- ! 時刻設定 ! Configure time !----------------------------------------------------------------- call DCDiffTimeCreate( & & diff = #{@arg_keyword} % current_time, & ! (out) & value = real( current_time_value, DP ), & ! (in) & unit = current_time_unit ) ! (in) !----------------------------------------------------------------- ! ヒストリファイルへのデータの時刻設定 ! Configure the time of history data !----------------------------------------------------------------- varnames = HstNmlInfoNames( #{@arg_keyword} % gthstnml ) call Split( str = varnames, sep = ',', & ! (in) & carray = varnames_array ) ! (out) vnmax = size( varnames_array ) do i = 1, vnmax name = varnames_array(i) if ( trim( name ) == '' ) exit call HstNmlInfoOutputStepDisable( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (inout) & name = name, & ! (in) & err = err ) ! (out) nullify( gthist ) call HstNmlInfoAssocGtHist( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & history = gthist, & ! (out) & err = err ) ! (out) if ( HistoryInitialized( gthist ) ) then call HstNmlInfoInquire( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & interval_unit = interval_unit ) ! (out) call HistorySetTime( & & history = gthist, & ! (inout) & time = & & real( EvalbyUnit( #{@arg_keyword} % current_time, & & interval_unit) ) ) ! (in) end if end do EOF when 'nmlread' str = <<-EOF !----------------------------------------------------------------- ! 文字型引数を NAMELIST 変数群へ代入 ! Substitute character arguments to NAMELIST group !----------------------------------------------------------------- !!$ key00 = key00_ !---------------------------------------------------------------- ! NAMELIST ファイルのオープン ! 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 !----------------------------------------------------------------- ! NAMELIST 変数群の取得 ! Get NAMELIST group !----------------------------------------------------------------- !------------------------- ! 係数などの取得 ! Get coefficients etc. !!$ rewind( unit_nml ) !!$ read( unit = unit_nml, & ! (in) !!$ & nml = #{@mod_name}_nml, & ! (out) !!$ & 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 !!$ !------------------------- ! 出力データの個別情報の取得 ! Get individual information of output data rewind( unit_nml ) iostat_nml = 0 pos_nml = '' do while ( trim(pos_nml) /= 'APPEND' .and. iostat_nml == 0 ) name = '' file = '' call HstNmlInfoInquire( & & gthstnml = gthstnml, & ! (in) & interval_value = interval_value, & ! (out) & interval_unit = interval_unit, & ! (out) & precision = precision, & ! (out) & average = average, & ! (out) & fileprefix = fileprefix ) ! (out) read( unit = unit_nml, & ! (in) & nml = #{@mod_name}_history_nml, & ! (out) & iostat = iostat_nml ) ! (out) inquire( unit = unit_nml, & ! (in) & position = pos_nml ) ! (out) if ( iostat_nml == 0 ) then call MessageNotify( 'M', subname, & & 'NAMELIST group "%c" is loaded from "%c".', & & c1='#{@mod_name}_history_nml', c2=trim(nmlfile) ) write(STDOUT, nml = #{@mod_name}_history_nml) call HstNmlInfoAdd( & & gthstnml = gthstnml, & ! (in) & name = name, & ! (in) & file = file, & ! (in) & interval_value = interval_value, & ! (in) & interval_unit = interval_unit, & ! (in) & precision = precision, & ! (in) & average = average, & ! (in) & fileprefix = fileprefix ) ! (in) else call MessageNotify( 'W', subname, & & 'NAMELIST group "%c" is not found in "%c" any more (iostat=%d).', & & c1='#{@mod_name}_history_nml', c2=trim(nmlfile), & & i = (/iostat_nml/) ) end if end do close( unit_nml ) !----------------------------------------------------------------- ! NAMELIST 変数群を文字型引数へ代入 ! Substitute NAMELIST group to character arguments !----------------------------------------------------------------- !!$ key00_ = key00 EOF else str = <<-EOF !----------------------------------------------------------------- ! *#{@arg_keyword}* に格納されている設定値の取り出し ! Fetch setting values stored in *#{@arg_keyword}* !----------------------------------------------------------------- !!$ CoefAlpha = #{@arg_keyword} % CoefAlpha !!$ DelTime = EvalSec( #{@arg_keyword} % delta_time ) EOF end return str.chomp end def dc_default_terminate case @kind when 'initialized' return "" 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 def dc_default_internal_procedures str = '' case @kind when 'create' str << <<-EOF contains subroutine output_init ! ! 変数 *name* に関して出力ファイルの初期設定を行います. ! 出力ファイル名や出力間隔などの情報は #{@arg_keyword} % gthstnml ! から取り出されます. ! ! 変数 *name* に関して出力が行われる場合には, ! *gthist* に出力先ファイルの gt4_history#GT_HISTORY ! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします. ! ! また, 出力データの精度を precision に, ! 出力データ平均化の可否を average に設定します. ! ! 標準出力に表示される変数リスト *registered_varnames* に ! *name*, *longname*, *dims*, *units* が登録されます. ! ! An output file is initialized for a variable *name*. ! Information such as the output filename and output intervals ! is taken out of "#{@arg_keyword} % gthstnml". ! ! When output is done for the variable *name*, *gthist* is ! associated with the "gt4_history#GT_HISTORY" variable of ! the output file. Otherwise, *gthist* is nullified. ! ! Moreover, the accuracy of output data is set to *precision*, and ! right or wrong of averaging the output data is set to *average*. ! ! *name*, *longname*, *dims*, *units* are registered to ! a list of variables *registered_varnames* that is printed to ! standard output. ! use dc_date, only: DCDiffTimeCreate, EvalSec, EvalByUnit use gt4_history_nmlinfo, only: GTHST_NMLINFO, & & HstNmlInfoInitialized, HstNmlInfoInquire, & & HstNmlInfoOutputValid, HstNmlInfoAssocGtHist, HstNmlInfoPutLine, & & HstNmlInfoSetValidName use gt4_history, only: GT_HISTORY, & & HistoryCreate, HistoryAddVariable, HistoryPut, & & HistoryAddAttr, HistoryInitialized !----------------------------------- ! 作業変数 ! Work variables character(STRING):: file ! ヒストリデータのファイル名. ! History data filenames character(STRING):: dims_str ! 座標軸のリスト. ! List of axes real:: interval_value ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output real(DP), parameter:: PI = 3.1415926535897930_DP ! $ \\pi $ . 円周率. Circular constant continue !----------------------------------------------------------------- ! 標準出力に表示される変数の登録 ! Register a variable name for print to standard output !----------------------------------------------------------------- if ( allocated(dims) ) then dims_str = JoinChar( dims, ',' ) else dims_str = '' end if call DCHashPut( hashv = registered_varnames, & ! (inout) & key = name, & ! (in) & value = trim( longname ) // ' [' // & & trim( units ) // '] {' // & & trim( dims_str ) // '}' ) ! (in) !----------------------------------------------------------------- ! 変数の初期化 ! Initialize variable !----------------------------------------------------------------- nullify( gthist ) precision = 'float' average = .false. !----------------------------------------------------------------- ! 変数名の有効性を設定 ! Set validation of the variable name !----------------------------------------------------------------- call HstNmlInfoSetValidName( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name ) ! (in) !----------------------------------------------------------------- ! 出力が有効かどうかを確認する ! Confirm whether the output is effective !----------------------------------------------------------------- if ( .not. HstNmlInfoOutputValid( #{@arg_keyword} % gthstnml, name ) ) then return end if !----------------------------------------------------------------- ! GT_HISTORY 変数の取得 ! Get "GT_HISTORY" variable !----------------------------------------------------------------- call HstNmlInfoAssocGtHist( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & history = gthist, & ! (out) & err = err ) ! (out) if ( present_and_true( err ) ) return call HstNmlInfoInquire( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & precision = precision, & ! (out) & average = average, & ! (out) & err = err ) ! (out) if ( present_and_true( err ) ) return !----------------------------------------------------------------- ! GT_HISTORY 変数の初期設定の確認 ! Check initialization of "GT_HISTORY" variable !----------------------------------------------------------------- if ( HistoryInitialized( gthist ) ) then !--------------------------------------------------------------- ! HistoryAddVariable による変数作成 ! A variable is created by "HistoryAddVariable" !--------------------------------------------------------------- call HistoryAddVariable( & & history = gthist, & ! (inout) & varname = name, dims = dims, & ! (in) & longname = longname, units = units, & ! (in) & xtype = precision, average = average ) ! (in) return end if !----------------------------------------------------------------- ! HistoryCreate のための設定値の取得 ! Get the settings for "HistoryCreate" !----------------------------------------------------------------- call HstNmlInfoInquire( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & file = file, & ! (out) & interval_unit = interval_unit, & ! (out) & interval_value = interval_value, & ! (out) & err = err ) ! (out) if ( present_and_true( err ) ) return !----------------------------------------------------------------- ! HistoryCreate によるファイル作成 ! Files are created by "HistoryCreate" !----------------------------------------------------------------- !!$ call HistoryCreate( & !!$ & history = gthist, & ! (out) !!$ & file = file, & ! (in) !!$ & title = 'Sample program of dcmodel programming guideline', & ! (in) !!$ & source = 'dcmodel project : ' // trim(version), & ! (in) !!$ & institution = 'GFD Dennou Club', & ! (in) !!$ & dims = StoA( 'lon', 'lat', 'time' ), & ! (in) !!$ & dimsizes = (/ #{@arg_keyword} % imax, #{@arg_keyword} % jmax, 0 /), & ! (in) !!$ & longnames = StoA( 'longitude', 'latitude', 'time' ), & ! (in) !!$ & units = StoA( 'degree_east', 'degree_north', & !!$ & interval_unit ), & ! (in) !!$ & origin = real( EvalbyUnit( #{@arg_keyword} % current_time, & !!$ & interval_unit) ), & ! (in) !!$ & interval = interval_value, & ! (in) !!$ & err = err ) ! (out) !!$ if ( present_and_true( err ) ) then !!$ nullify( gthist ) !!$ return !!$ end if !!$ !!$ call HistoryAddAttr( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'lon', attrname = 'standard_name', & ! (in) !!$ & value = 'longitude' ) ! (in) !!$ call HistoryAddAttr( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'lat', attrname = 'standard_name', & ! (in) !!$ & value = 'latitude' ) ! (in) !!$ call HistoryAddAttr( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'time', attrname = 'standard_name', & ! (in) !!$ & value = 'time' ) ! (in) !!$ !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'lon', & ! (in) !!$ & array = #{@arg_keyword} % x_Lon / PI * 180.0_DP ) ! (in) !!$ call HistoryPut( & !!$ & history = gthist, & ! (inout) !!$ & varname = 'lat', & ! (in) !!$ & array = #{@arg_keyword} % y_Lat / PI * 180.0_DP ) ! (in) !----------------------------------------------------------------- ! HistoryAddVariable による変数作成 ! A variable is created by "HistoryAddVariable" !----------------------------------------------------------------- if ( HistoryInitialized( gthist ) ) then call HistoryAddVariable( & & history = gthist, & ! (inout) & varname = name, dims = dims, & ! (in) & longname = longname, units = units, & ! (in) & xtype = precision, average = average ) ! (in) else nullify( gthist ) end if end subroutine output_init EOF when 'calc' str << <<-EOF contains subroutine output_check ! ! 変数 *name* を出力するかどうかをチェックします. ! 出力に関する情報は dcm_sam_cod % gthstnml から取り出されます. ! ! 変数 *name* に関して出力するよう設定されている場合には, ! *gthist* に出力先ファイルの gt4_history#GT_HISTORY ! 型変数を結合させます. そうでない場合は, *gthist* を空状態にします. ! ! また, 現在時刻を *time* に設定します. ! ! Check whether to output variable *name*. ! Information about output is taken out of "dcm_sam_cod % gthstnml". ! ! When output is done for the variable *name*, *gthist* is ! associated with "gt4_history#GT_HISTORY" variable of ! the output file. Otherwise, *gthist* is nullified. ! ! Moreover, current time is set to *time*. ! character(TOKEN):: interval_unit ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output continue nullify( gthist ) time = 0.0 if ( HstNmlInfoOutputValid( #{@arg_keyword} % gthstnml, name ) ) then call HstNmlInfoInquire( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & interval_unit = interval_unit ) ! (out) time = real( EvalbyUnit( #{@arg_keyword} % current_time, interval_unit ) ) if ( present_and_true( historyput_flag ) ) time = 0.0 call HstNmlInfoAssocGtHist( & & gthstnml = #{@arg_keyword} % gthstnml, & ! (in) & name = name, & ! (in) & history = gthist, err = err ) ! (out) if ( present_and_true( err ) ) then nullify( gthist ) return end if if ( .not. HistoryInitialized( gthist ) ) nullify( gthist ) end if end subroutine output_check EOF end 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 = '' str << <<-EOF != #{@mod_name} モジュールのテストプログラム ! != 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:: ! ! Note that Japanese and English are described in parallel. ! ! #{@mod_name} モジュールの動作テストを行うためのプログラムです. ! このプログラムがコンパイルできること, および実行時に ! プログラムが正常終了することを確認してください. ! ! 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}, #{@mod_basename}Create, & & #{@mod_basename}Calculation, #{@mod_basename}Close, & & #{@mod_basename}PutLine, #{@mod_basename}Initialized, & & #{@mod_basename}SetTime use dc_test, only: AssertEqual, AssertGreaterThan, AssertLessThan use dc_types, only: DP, STRING use dc_string, only: StoA, PutLine 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 = & & '#{@program_name} $Name: dcpam4-20080624-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)' !------------------------------------------------------------------- ! 格子点数・最大全波数 ! Grid points and maximum truncated wavenumber !------------------------------------------------------------------- !!$ integer, parameter:: imax = 8 !!$ ! 経度格子点数. !!$ ! Number of grid points in longitude !!$ integer, parameter:: jmax = 4 !!$ ! 緯度格子点数. !!$ ! Number of grid points in latitude !------------------------------------------------------------------- ! 軸データ ! Axes data !------------------------------------------------------------------- !!$ real(DP):: x_Lon (0:imax-1) !!$ ! 経度. Longitude !!$ real(DP):: y_Lat (0:jmax-1) !!$ ! 緯度. Latitude !------------------------------------------------------------------- ! 物理量 ! Physical values !------------------------------------------------------------------- !!$ real(DP):: x_Data1 (0:imax-1) !!$ ! データ 1. Data 1 !!$ real(DP):: y_Data2 (0:jmax-1) !!$ ! データ 2. Data 2 !------------------------------------------------------------------- ! 定数 ! Constants !------------------------------------------------------------------- !!$ real(DP), parameter:: PI = 3.1415926535897930_DP !!$ ! $ \\pi $ . 円周率. Circular constant !------------------------------------------------------------------- ! 作業変数 ! Work variables !------------------------------------------------------------------- !!$ integer:: i, j ! DO ループ用作業変数 !!$ ! Work variables for DO loop type(ARGS):: arg ! コマンドライン引数. ! Command line options logical:: OPT_namelist ! -N, --namelist オプションの有無. ! Existence of '-N', '--namelist' option character(STRING):: VAL_namelist ! -N, --namelist オプションの値. ! Value of '-N', '--namelist' option type(#{@mod_arg_type}):: #{@mod_arg_keyword}00, #{@mod_arg_keyword}01 !!$ type(#{@mod_arg_type}):: #{@mod_arg_keyword}02, #{@mod_arg_keyword}03 logical:: err character(*), parameter:: subname = '#{@program_name}' continue !------------------------------------------------------------------- ! コマンドライン引数の処理 ! Command line options handling !------------------------------------------------------------------- call cmdline_optparse ! これは内部サブルーチン. This is an internal subroutine !------------------------------------------------------------------- ! 軸データの設定 ! Configure axes data !------------------------------------------------------------------- !!$ x_Lon = (/ 0.0, 45.0, 90.0, 135.0, & !!$ & 180.0, 225.0, 270.0, 315.0 /) * PI / 180.0_DP !!$ y_Lat = (/ -59.4444, -19.8757, 19.8757, 59.4444 /) * PI / 180.0_DP !------------------------------------------------------------------- ! 基本の初期設定, 終了処理テスト ! Basic initialization and termination test !------------------------------------------------------------------- call #{@mod_basename}Create( & & #{@mod_arg_keyword} = #{@mod_arg_keyword}00 & ! (out) !!$ & , imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = 0.0001_DP, DelTime = 0.5_DP & ! (in) & ) call AssertEqual( 'basic initialization test 1', & & answer = .true., check = #{@mod_basename}Initialized(#{@mod_arg_keyword}00) ) call #{@mod_basename}PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) call #{@mod_basename}Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (inout) call AssertEqual( 'basic termination test 1', & & answer = .false., check = #{@mod_basename}Initialized(#{@mod_arg_keyword}00) ) call #{@mod_basename}PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) !------------------------------------------------------------------- ! 重複初期設定に関するエラー処理のテスト ! Error handling related to duplicated initialization test !------------------------------------------------------------------- call #{@mod_basename}Create( & & #{@mod_arg_keyword} = #{@mod_arg_keyword}00 & ! (inout) !!$ & , imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = 0.0001_DP, DelTime = 0.5_DP & ! (in) & ) call #{@mod_basename}Create( & & #{@mod_arg_keyword} = #{@mod_arg_keyword}00, & ! (inout) !!$ & imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = 0.0001_DP, DelTime = 0.5_DP, & ! (in) & err = err ) ! (out) call AssertEqual( 'error handling related to duplicated initialization test 1', & & answer = .true., check = err ) call #{@mod_basename}PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) call #{@mod_basename}Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (inout) !------------------------------------------------------------------- ! 終了処理に関するエラー処理のテスト ! Error handling related to termination test !------------------------------------------------------------------- call #{@mod_basename}Close( & & #{@mod_arg_keyword} = #{@mod_arg_keyword}00, & ! (inout) & err = err ) ! (out) call AssertEqual( 'error handling related to termination test 1', & & answer = .true., check = err ) !------------------------------------------------------------------- ! NAMELIST ファイルの読み込みテスト ! NAMELIST file loading test !------------------------------------------------------------------- call #{@mod_basename}Create( & & #{@mod_arg_keyword} = #{@mod_arg_keyword}01, & ! (out) !!$ & imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = - 0.0001_DP, DelTime = 0.5_DP, & ! (in) & nmlfile = VAL_namelist ) ! (in) call AssertEqual( 'NAMELIST file loading test 1', & & answer = .true., check = #{@mod_basename}Initialized(#{@mod_arg_keyword}01) ) call #{@mod_basename}PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}01 ) ! (in) call #{@mod_basename}Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}01 ) ! (inout) !------------------------------------------------------------------- ! 無効な値に関するエラー処理のテスト ! Error handling related to invalid values test !------------------------------------------------------------------- !!$ call #{@mod_basename}Create( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}02, & ! (out) !!$ & imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = - 0.0001_DP, DelTime = 0.5_DP, & ! (in) !!$ & err = err ) ! (out) !!$ call AssertEqual( 'error handling related to invalid values test 1', & !!$ & answer = .true., check = err ) !!$ call #{@mod_basename}Create( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}02, & ! (inout) !!$ & imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = 0.0001_DP, DelTime = - 0.5_DP, & ! (in) !!$ & err = err ) ! (out) !!$ call AssertEqual( 'error handling related to invalid values test 2', & !!$ & answer = .true., check = err ) !------------------------------------------------------------------- ! ヒストリデータ出力テスト ! History data output test !------------------------------------------------------------------- !!$ call #{@mod_basename}Create( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (out) !!$ & imax = imax, jmax = jmax, & ! (in) !!$ & x_Lon = x_Lon, y_Lat = y_Lat, & ! (in) !!$ & CoefAlpha = 0.01_DP, DelTime = 0.5_DP, & ! (in) !!$ & current_time_value = 0.0, & ! (in) !!$ & current_time_unit = 'sec', & ! (in) !!$ & history_varlist = 'Data2', & ! (in) !!$ & history_interval_value = 2.0, & ! (in) !!$ & history_interval_unit = 'sec', & ! (in) !!$ & history_precision = 'float', & ! (in) !!$ & history_fileprefix = 'AP_' ) ! (in) !!$ call #{@mod_basename}PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}03 ) ! (in) !!$ !!$ do i = 0, imax-1 !!$ x_Data1(i) = i * 1.0_DP !!$ end do !!$ do j = 0, jmax-1 !!$ y_Data2(j) = j * 1.1_DP !!$ end do !!$ !!$ do i = 1, 12 !!$ call #{@mod_basename}Calculation( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & x_Data1 = x_Data1, y_Data2 = y_Data2 ) ! (inout) !!$ end do !!$ !!$ call #{@mod_basename}SetTime( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & current_time_value = 1.0, current_time_unit = 'minute' ) ! (in) !!$ !!$ call #{@mod_basename}Calculation( & !!$ & #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & x_Data1 = x_Data1, y_Data2 = y_Data2, & ! (inout) !!$ & historyput_flag = .true. ) ! (in) !!$ !!$ call #{@mod_basename}Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}03 ) ! (inout) contains subroutine cmdline_optparse ! ! コマンドライン引数の処理を行います ! ! Handle command line options ! call DCArgsOpen( arg = arg ) ! (out) call DCArgsHelpMsg( arg = arg, & ! (inout) & category = 'Title', msg = title ) ! (in) call DCArgsHelpMsg( arg = arg, & ! (inout) & category = 'Usage', & ! (in) & msg = './' // trim(subname) // & & ' [Options]' ) ! (in) call DCArgsHelpMsg( arg = arg, & ! (inout) & category = 'Source', msg = source ) ! (in) call DCArgsHelpMsg( arg = arg, & ! (inout) & category = 'Institution', & ! (in) & msg = institution ) ! (in) call DCArgsOption( arg = arg, & ! (inout) & options = StoA('-N', '--namelist'), & ! (in) & flag = OPT_namelist, & ! (out) & value = VAL_namelist, & ! (out) & 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 #{@program_name} EOF if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end 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 = '' str << <<-EOF #= #{@mod_name} モジュールのテストプログラム用 NAMELIST ファイル # #= 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 CoefAlpha=0.05, ! $ \\alpha $ . 係数. Coefficient key00='keyword' ! キーワード. Keyword / &#{@mod_name}_history_nml name = '', ! 変数名. ! 空白の場合には, 以下の設定値は ! デフォルトの設定として用いられる. ! ! Variable identifier. ! If blank is given, their values are ! used as default settings. interval_value = 5.0, !!$! interval_value = 10.0, ! ヒストリデータの出力間隔の数値. ! 負の値を与えると, 出力を抑止します. ! ! Numerical value for interval of history data output ! Negative values suppresses output. interval_unit = 'sec', !!$! interval_unit = 'min', !!$! interval_unit = 'hrs', !!$! interval_unit = 'day', ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output precision = 'float', !!$! precision = 'double', ! ヒストリデータの精度. ! Precision of history data average = .false., !!$! average = .true., ! 出力データの平均化フラグ. ! Flag for average of output data fileprefix = 'NP_' !!$! fileprefix = '' !!$! fileprefix = 'data01/' ! ヒストリデータのファイル名の接頭詞. ! Prefixes of history data filenames / !!$!&#{@mod_name}_history_nml !!$! name='Data1,Data2', !!$! ! 変数名. !!$! ! カンマで区切って並べることで, !!$! ! 複数の変数に関する設定を一度に !!$! ! 行うことができる. !!$! ! (例: "Data1,Data2" ). !!$! ! !!$! ! Variable identifier. !!$! ! Multiple comma-deliminated variables !!$! ! are configured at one time !!$! ! (exp. "Data1,Data2" ). !!$! file = '' !!$! ! 出力ファイル名 (デフォルトは .nc). !!$! ! Output file name (Default is ".nc"). !!$!/ !!$&#{@mod_name}_history_nml !!$ name='Data1', !!$ ! 変数名. Variable identifier !!$ file='NPI_Data1.nc' !!$ ! 出力ファイル名 (デフォルトは .nc). !!$ ! Output file name (Default is ".nc"). !!$/ !!$&#{@mod_name}_history_nml !!$ name='Data2', !!$ ! 変数名. Variable identifier !!$ average=.true. !!$ ! 出力データの平均化フラグ. !!$ ! Flag for average of output data !!$/ EOF if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end 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 if @lang_ja return str.gsub(/\n?/m, '').gsub(/<\/ja>\n?/m, '') else return str.gsub(/.*?<\/ja>\n?/m, '') end 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\") \"settime\", \"calc\", \"sample\")" ){|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] = true} 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] ||= 'sample' 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