#!/usr/bin/env ruby # #= Fortran 90/95 dcmodel sample code maker # #Authors:: Yasuhiro MORIKAWA #Version:: $Id: dcmodel_f90sample_maker.rb,v 1.46 2007/10/11 19:53:14 morikawa Exp $ #Tag Name:: $Name: dcpam4-20071012 $ #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 ! ! Create :: #{@mod_arg_type} 型変数の初期設定 ! Close :: #{@mod_arg_type} 型変数の終了処理 ! PutLine :: #{@mod_arg_type} 型変数に格納されている情報の印字 ! initialized :: #{@mod_arg_type} 型変数が初期設定されているか否か ! SetTime :: 時刻の設定 ! Calculation :: 演算 ! ------------ :: ------------ ! 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}" ! SetTime :: Configure time ! Calculation :: Calculation ! !== Usage ! ! 始めに, #{@mod_arg_type} 型の変数を定義し, Create で初期設定を行います. !-- ! モジュールの利用法を記述してください. !++ ! #{@mod_arg_type} 型の変数の終了処理には Close を用いてください. ! ! 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, STRING use dc_date_types, only: DC_DIFFTIME use gt4_history, only: GT_HISTORY implicit none private public:: #{@mod_arg_type}, Create, Close, PutLine, initialized public:: SetTime, Calculation !!$ public:: #{@mod_arg_type}_HISTNML EOF typemake = DCModelF90SampleTypeMaker.new typemake.lang_ja = @lang_ja typemake.set_typename(@mod_arg_type) typemake.set_modname(@mod_name) str << typemake.to_s str << "\n" str << <<-EOF character(*), parameter:: version = & & '$Name: dcpam4-20071012 $' // & & '$#{}I#{}d: $' EOF str << <<-EOF !----------------------------------------------------------------- ! 公開手続 ! Public procedures !----------------------------------------------------------------- EOF proc_public_list = ['create', 'close', 'putline', 'initialized', 'settime', 'calc'] proc_private_list = ['nmlread', 'hstnmlassoc', 'hstsetxy', 'sample'] proc_public_list.each {|proc| if !(proc == 'initialized') 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 #{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 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' proc_name = 'HstNmlAssoc' if proc_name == 'Hstnmlassoc' proc_name = 'HstSetXY' if proc_name == 'Hstsetxy' str << <<-EOF interface #{proc_name} 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 = 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 interactive_setup @type_name = f90entityname_from_stdin(@type_name, 'type_name') end # # F90 ソースコードを返す. # def to_s str = <<-EOF type #{@type_name} ! ! まず, Create で "#{@type_name}" 型の変数を初期設定して下さい. ! 初期設定された "#{@type_name}" 型の変数を再度利用する際には, ! Close によって終了処理を行ってください. ! ! Initialize "#{@type_name}" variable by "Create" before usage. ! If you reuse "#{@type_name}" variable again for another application, ! terminate by "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 !!$ real(DP):: DelTime ! $ \\Delta t $ . タイムステップ. Time step !!$ !----------------------------------------------------------------- ! 時刻管理 ! 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 !----------------------------------------------------------------- !!$ character(TOKEN), pointer:: history_varlist_array(:) =>null() !!$ ! ヒストリデータの出力変数リスト. !!$ ! List of variables output to history data. !!$ character(STRING):: history_fileprefix !!$ ! ヒストリデータのファイル名の接頭詞. !!$ ! Prefix of history data filenames !!$ !!$ type(#{@type_name}_HISTNML), pointer:: hist_nml(:) =>null() !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! この配列の 1 番目にはデフォルトの設定が格納 !!$ ! され, 2 番目以降に個別の設定が格納される. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml". !!$ ! Default settings are stored in !!$ ! the first element of this array, !!$ ! and individual settings are stored in !!$ ! the second or more. !----------------------------------- ! gt4_history モジュール用構造体 ! Derived type for "gt4_history" module !!$ type(GT_HISTORY), pointer:: gthist_data1 =>null() !!$ type(GT_HISTORY), pointer:: gthist_data2 =>null() end type #{@type_name} !!$ type #{@type_name}_HISTNML !!$ ! !!$ ! NAMELIST\##{@mod_name}_history_nml からデータの出力情報 !!$ ! を個別に取得するための構造データ型です. 外部からの参照は !!$ ! 行わないでください. !!$ ! !!$ ! This derived type is worked for input information about !!$ ! data output individually from !!$ ! "NAMELIST\##{@mod_name}_history_nml" !!$ ! Do not refer this derived type externally. !!$ ! !!$ character(TOKEN):: name !!$ ! 変数名. Variable name !!$ character(STRING):: file !!$ ! ヒストリデータのファイル名. !!$ ! History data filenames !!$ type(DC_DIFFTIME):: history_interval_time !!$ ! ヒストリデータの出力間隔. !!$ ! Interval of history data output !!$ real(DP):: history_interval_value !!$ ! ヒストリデータの出力間隔の数値. !!$ ! Numerical value for interval of history data output !!$ character(TOKEN):: history_interval_unit !!$ ! ヒストリデータの出力間隔の単位. !!$ ! Unit for interval of history data output !!$ character(TOKEN):: history_precision !!$ ! ヒストリデータの精度. !!$ ! Precision of history data !!$ logical:: history_average !!$ ! 出力データの平均化フラグ. !!$ ! Flag for average of output data. !!$ logical:: dummy0 ! 8 ビット境界用のダミー変数. !!$ ! Dummy variable for 8 bit boundary !!$ end type #{@type_name}_HISTNML 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', 'hstnmlassoc', 'hstsetxy', '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' when 'hstnmlassoc' @operate_name = 'HstNmlAssoc' when 'hstsetxy' @operate_name = 'HstSetXY' 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', 'hstnmlassoc', 'hstsetxy', '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, & !!$ & history_varlist_, & !!$ & history_fileprefix_, & !!$ & hist_nml, & & err ) EOF when 'hstnmlassoc' str = <<-EOF subroutine #{@basename}#{@operate_name}( & !!$ & name, hist_nml, hptr, & & err ) EOF when 'hstsetxy' str = <<-EOF subroutine #{@basename}#{@operate_name}( #{@arg_keyword}, & !!$ & file, hptr, & !!$ & history, xdim, ydim, timedim, & & 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} 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}* が Create によって初期設定 ! されていない場合, プログラムはエラーを発生させます. ! ! Deconstructor of "#{@arg_type}". ! Note that if *#{@arg_keyword}* is not initialized by "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}* が 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 "Create" yet, ! error is occurred. ! EOF when 'calc' str << <<-EOF ! ! *x_Data1* と *y_Data2* に対して演算を行い, 変更された値を返します. ! 計算後, *#{@arg_keyword}* 内の時刻を更新します. ! ! なお, 与えられた *#{@arg_keyword}* が 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 "Create" yet, ! error is occurred. ! EOF when 'nmlread' str << <<-EOF ! ! NAMELIST ファイル *nmlfile* から値を入力するための ! 内部サブルーチンです. Create 内で呼び出されることを ! 想定しています. ! ! 値が NAMELIST ファイル内で指定されていない場合には, ! 入力された値がそのまま返ります. ! ! なお, *nmlfile* に空文字が与えられた場合, または ! 与えられた *nmlfile* を読み込むことができない場合, ! プログラムはエラーを発生させます. ! ! 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 when 'hstnmlassoc' str << <<-EOF ! ! データ出力情報が格納されたポインタ配列 *hist_nml* 内の ! *name* に該当するデータの情報へ *hptr* を結合して返します. ! ! *hist_nml* が割り付けられていない場合, エラーを返します. ! ! Associate *hptr* to information of data correspond to *name* ! stored in pointer array *hist_nml*, and return it. ! ! If *hist_nml* is not allocated, error is occured. ! EOF when 'hstsetxy' str << <<-EOF ! ! このサブルーチンはモジュール内からの出力データの初期設定を行います. ! 内部的に使用されることを想定しているため, モジュール外部からは ! 呼び出さないでください. ! ! *file* に与えられた名前のファイルをオープンし, ファイル ID などが ! 格納された GT_HISTORY 変数 *history* を返します. ! *history* は空状態にして与えてください. ! ! なお, 与えられた *#{@arg_keyword}* が Create によって初期設定 ! されていない場合, プログラムはエラーを発生させます. ! ! This subroutine initializes settings of data output from this module. ! It is expected that this subroutine is used internally, so ! do not refer from the outside. ! ! A file with name *file* is opened, and "GT_HISTORY" variable ! *history* that stores file ID etc. is returned. ! Give disassociated *history*. ! ! If *#{@arg_keyword}* is not initialized by "Create" yet, ! error is occurred. ! EOF else str << <<-EOF !-- ! #{@basename}#{@operate_name} の要約を記述してください. !++ ! なお, 与えられた *#{@arg_keyword}* が Create によって初期設定 ! されていない場合, プログラムはエラーを発生させます. !-- ! 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_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 use dc_message, only: MessageNotify use dc_error, only: StoreError, DC_NOERR, #{@alreadyinit_err_code}, & & DC_EARGLACK, DC_ENEGATIVE, DC_ENOFILEREAD use dc_date, only: Create use gt4_history, only: GT_HISTORY, & & HistoryAddVariable, HistoryAddAttr EOF when 'close' str << <<-EOF use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history, only: HistoryClose EOF when 'settime' str << <<-EOF use dc_date, only: Create, EvalbyUnit use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history, only: HistorySetTime EOF when 'calc' str << <<-EOF use dc_present, only: present_and_true use dc_date, only: mod, operator(+), operator(==), EvalbyUnit use dc_error, only: StoreError, DC_NOERR, #{@noinit_err_code} use gt4_history, only: HistoryPut 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: Create use dc_error, only: StoreError, DC_NOERR, DC_ENOFILEREAD, DC_ENOASSOC EOF when 'hstnmlassoc' str << <<-EOF use dc_error, only: StoreError, DC_NOERR, DC_ENOASSOC EOF when 'hstsetxy' str << <<-EOF use dc_error, only: StoreError, DC_NOERR, DC_ENOTINIT, DC_ENOASSOC use dc_date, only: Create, EvalSec, EvalByUnit use gt4_history, only: GT_HISTORY, & & HistoryCreate, HistoryAddVariable, HistoryPut, & & HistoryAddAttr EOF else str << <<-EOF 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', 'hstnmlassoc' 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(DP), 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(DP), 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(DP), 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):: history_varlist_ !!$ character(STRING):: history_varlist !!$ ! ヒストリデータの出力変数リスト. !!$ ! カンマで区切って並べる. !!$ ! (例: "Data1,Data2" ). !!$ ! !!$ ! List of variables output to history data. !!$ ! Delimiter is comma. !!$ ! (exp. "Data1,Data2" ). !!$ ! !!$ character(*), intent(inout):: history_fileprefix_ !!$ character(STRING):: history_fileprefix !!$ ! ヒストリデータのファイル名の接頭詞. !!$ ! Prefix of history data filenames !!$ type(#{@arg_type}_HISTNML), pointer:: hist_nml(:) !!$ ! (inout) !!$ ! !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! この配列の 1 番目にはデフォルトの設定が格納 !!$ ! され, 2 番目以降に個別の設定が格納される. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml". !!$ ! Default settings are stored in !!$ ! the first element of this array, !!$ ! and individual settings are stored in !!$ ! the second or more. EOF when 'hstnmlassoc' str << <<-EOF !!$ character(*), intent(in):: name !!$ ! 変数名. Variable name !!$ type(#{@arg_type}_HISTNML), pointer:: hist_nml(:) !!$ ! (in) !!$ ! !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! この配列の 1 番目にはデフォルトの設定が格納 !!$ ! され, 2 番目以降に個別の設定が格納される. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml". !!$ ! Default settings are stored in !!$ ! the first element of this array, !!$ ! and individual settings are stored in !!$ ! the second or more. !!$ type(#{@arg_type}_HISTNML), pointer:: hptr !!$ ! (out) !!$ ! !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml" EOF when 'hstsetxy' str << <<-EOF !!$ character(*), intent(in):: file !!$ ! ヒストリデータのファイル名. !!$ ! History data filenames !!$ type(#{@arg_type}_HISTNML), pointer:: hptr !!$ ! (in) !!$ ! !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml" !!$ type(GT_HISTORY), pointer:: history !!$ ! (out) !!$ ! !!$ ! gt4_history モジュール用構造体. !!$ ! Derived type for "gt4_history" module !!$ character(*), intent(out):: xdim !!$ ! 経度の名称. Name of longitude !!$ character(*), intent(out):: ydim !!$ ! 緯度の名称. Name of latitude !!$ character(*), intent(out):: timedim !!$ ! 時刻の名称. Name of time 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 !!$ ! #{@mod_name} モジュール用 !!$ ! NAMELIST 変数群名. !!$ ! !!$ ! #{@mod_name}\#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}\#Create" is used, !!$ ! this NAMELIST group is loaded from !!$ ! the file. !!$ !!$ namelist /#{@mod_name}_varlist_nml/ & !!$ & history_varlist !!$ ! #{@mod_name} モジュールの !!$ ! ヒストリデータ出力リスト用 !!$ ! NAMELIST 変数群名. !!$ ! !!$ ! #{@mod_name}\#Create を使用する際に, !!$ ! オプショナル引数 *nmlfile* へ NAMELIST !!$ ! ファイル名を指定することで, そのファイルから !!$ ! この NAMELIST 変数群を読み込みます. !!$ ! !!$ ! NAMELIST group name for !!$ ! output list of history data of !!$ ! "#{@mod_name}" module. !!$ ! !!$ ! If a NAMELIST filename is specified to !!$ ! an optional argument *nmlfile* !!$ ! when "#{@mod_name}\#Create" is used, !!$ ! this NAMELIST group is loaded from !!$ ! the file. !!$ !!$ character(TOKEN):: name !!$ ! 変数名. !!$ ! 空白の場合には, この他の設定値は !!$ ! #{@mod_name} モジュールにおいて !!$ ! 出力されるデータ全ての !!$ ! デフォルト値となります. !!$ ! !!$ ! Variable name. !!$ ! If blank is given, other values are !!$ ! used as default values of output data !!$ ! in "#{@mod_name}". !!$ character(STRING):: file !!$ ! 出力ファイル名. !!$ ! これはデフォルト値としては使用されません. !!$ ! *name* に値が設定されている時のみ有効です. !!$ ! !!$ ! Output file name. !!$ ! This is not used as default value. !!$ ! This value is valid only when *name* is !!$ ! specified. !!$ !!$ real(DP):: history_interval_value !!$ ! ヒストリデータの出力間隔の数値. !!$ ! Numerical value for interval of history data output !!$ character(TOKEN):: history_interval_unit !!$ ! ヒストリデータの出力間隔の単位. !!$ ! Unit for interval of history data output !!$ character(TOKEN):: history_precision !!$ ! ヒストリデータの精度. !!$ ! Precision of history data !!$ !!$ logical:: history_average !!$ ! 出力データの平均化フラグ. !!$ ! Flag for average of output data !!$ !!$ namelist /#{@mod_name}_history_nml/ & !!$ & name, & !!$ & file, & !!$ & history_interval_value, & !!$ & history_interval_unit, & !!$ & history_precision, & !!$ & history_fileprefix, & !!$ & history_average !!$ ! #{@mod_name} モジュールのヒストリデータ用 !!$ ! NAMELIST 変数群名. !!$ ! !!$ ! #{@mod_name}\#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}\#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(TOKEN):: name !!$ ! 変数名. Variable name !!$ type(#{@arg_type}_HISTNML), pointer:: hptr =>null() !!$ ! NAMELIST\##{@mod_name}_history_nml !!$ ! から入手される個別のデータ出力情報. !!$ ! !!$ ! Individual data output information from !!$ ! "NAMELIST\##{@mod_name}_history_nml" EOF end case @kind when 'create' str << <<-EOF !!$ character(STRING):: history_filename !!$ ! ヒストリデータのファイル名. !!$ ! History data filenames !!$ character(STRING):: history_varlist_work !!$ type(GT_HISTORY), pointer:: history_work =>null() !!$ ! gt4_history モジュール用構造体. !!$ ! Derived type for "gt4_history" module !!$ character(TOKEN):: xdim !!$ ! 経度の名称. Name of longitude !!$ character(TOKEN):: ydim !!$ ! 緯度の名称. Name of latitude !!$ character(TOKEN):: timedim !!$ ! 時刻の名称. Name of time 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 !!$ integer:: hmax ! hist_nml(:) のサイズ. !!$ ! Size of "hist_nml(:)" !!$ type(#{@arg_type}_HISTNML), allocatable:: hist_nml_work(:) EOF when 'hstsetxy' str << <<-EOF !!$ real(DP), parameter:: PI = 3.1415926535897930_DP !!$ ! $ \\pi $ . 円周率. Circular constant EOF end case @kind when 'putline', 'hstnmlassoc', 'settime' str << <<-EOF !!$ integer:: hmax ! hist_nml(:) のサイズ. !!$ ! Size of "hist_nml(:)" !!$ integer:: i ! DO ループ用作業変数 !!$ ! Work variables for DO loop 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 'nmlread', 'hstnmlassoc' str = <<-EOF !----------------------------------------------------------------- ! 割付状態の確認 ! Check allocation !----------------------------------------------------------------- !!$ if ( .not. associated( hist_nml ) ) then !!$ stat = DC_ENOASSOC !!$ cause_c = 'hist_nml' !!$ goto 999 !!$ end if !!$ !!$ if ( size( hist_nml ) < 1 ) then !!$ stat = DC_ENOASSOC !!$ cause_c = 'hist_nml' !!$ goto 999 !!$ end if EOF when 'hstsetxy' str = <<-EOF !----------------------------------------------------------------- ! 割付状態の確認 ! Check allocation !----------------------------------------------------------------- !!$ if ( .not. associated( hptr ) ) then !!$ stat = DC_ENOASSOC !!$ cause_c = 'hptr' !!$ goto 999 !!$ end if 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', 'hstnmlassoc', 'hstsetxy' 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 !----------------------------------------------------------------- ! $ \Delta t $ の設定 ! Configure $ \Delta t $ !----------------------------------------------------------------- !!$ #{@arg_keyword} % DelTime = DelTime !----------------------------------------------------------------- ! 時刻管理 ! Time control !----------------------------------------------------------------- !!$ if ( present(current_time_value) .and. present(current_time_unit) ) then !!$ call Create( & !!$ & diff = #{@arg_keyword} % current_time, & ! (out) !!$ & value = current_time_value, & ! (in) !!$ & unit = current_time_unit ) ! (in) !!$ else !!$ call Create( & !!$ & diff = #{@arg_keyword} % current_time, & ! (out) !!$ & value = 0.0_DP, & ! (in) !!$ & unit = 'sec' ) ! (in) !!$ end if !!$ !!$ call Create( & !!$ & 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} % DelTime = DelTime !----------------------------------------------------------------- ! ヒストリファイルへのデータ出力設定 ! Configure the settings for history data output !----------------------------------------------------------------- !!$ if ( associated( #{@arg_keyword} % hist_nml ) ) deallocate( #{@arg_keyword} % hist_nml ) !!$ allocate( #{@arg_keyword} % hist_nml(1) ) !------------------------- ! デフォルト値 ! Default values !!$ history_varlist_work = '' !!$ #{@arg_keyword} % history_fileprefix = '' !!$ #{@arg_keyword} % hist_nml(1) % name = '' !!$ #{@arg_keyword} % hist_nml(1) % file = '' !!$ #{@arg_keyword} % hist_nml(1) % history_interval_value = -1.0_DP !!$ #{@arg_keyword} % hist_nml(1) % history_interval_unit = 'sec' !!$ #{@arg_keyword} % hist_nml(1) % history_precision = 'float' !!$ #{@arg_keyword} % hist_nml(1) % history_average = .false. !------------------------- ! オプショナル引数からの値 ! Values from optional arguments !!$ if ( present(history_varlist) ) history_varlist_work = history_varlist !!$ if ( present(history_fileprefix) ) #{@arg_keyword} % history_fileprefix = history_fileprefix !!$ if ( present(history_interval_value) ) #{@arg_keyword} % hist_nml(1) % history_interval_value = history_interval_value !!$ if ( present(history_interval_unit) ) #{@arg_keyword} % hist_nml(1) % history_interval_unit = history_interval_unit !!$ if ( present(history_precision) ) #{@arg_keyword} % hist_nml(1) % history_precision = history_precision !----------------------------------------------------------------- ! 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) !!$ & history_varlist_ = history_varlist_work, & ! (inout) !!$ & history_fileprefix_ = #{@arg_keyword} % history_fileprefix, & ! (inout) !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (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 !----------------------------------------------------------------- ! ヒストリーデータに関する時刻管理 ! Time control for history data !----------------------------------------------------------------- !!$ call Create( & !!$ & diff = #{@arg_keyword} % hist_nml(1) % history_interval_time, & ! (out) !!$ & value = #{@arg_keyword} % hist_nml(1) % history_interval_value, & ! (in) !!$ & unit = #{@arg_keyword} % hist_nml(1) % history_interval_unit ) ! (in) !----------------------------------------------------------------- ! 内部ルーチン HstSetXY によるファイル作成 ! Files are created by internal subroutine "HstSetXY" !----------------------------------------------------------------- !!$ call Split( & !!$ & str = history_varlist_work, sep = ',', & ! (in) !!$ & carray = #{@arg_keyword} % history_varlist_array ) ! (out) !!$ !!$ !------------------------- !!$ ! x_Data1 の出力設定 !!$ ! Configure the settings for "x_Data1" output !!$ name = 'Data1' !!$ history_filename = trim(#{@arg_keyword} % history_fileprefix) // 'Data1.nc' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ if ( trim(hptr % file) /= '' ) history_filename = trim(hptr % file) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. hptr % history_interval_value > 0.0_DP ) then !!$ !!$ if ( associated( history_work ) ) nullify( history_work ) !!$ !!$ call HstSetXY( #{@arg_keyword} = #{@arg_keyword}, & ! (inout) !!$ & file = history_filename, hptr = hptr, & ! (in) !!$ & history = history_work, & ! (out) !!$ & xdim = xdim, ydim = ydim, timedim = timedim, & ! (out) !!$ & err = err ) ! (out) !!$ !!$ #{@arg_keyword} % gthist_data1 => history_work !!$ nullify( history_work ) !!$ !!$ call HistoryAddVariable( & !!$ & history = #{@arg_keyword} % gthist_data1, & ! (inout) !!$ & varname = 'Data1', & ! (in) !!$ & dims = (/xdim, timedim/), & ! (in) !!$ & longname = 'Sample data (1)', & ! (in) !!$ & units = '1', & ! (in) !!$ & xtype = hptr % history_precision ) ! (in) !!$ !!$ end if !!$ !!$ !------------------------- !!$ ! y_Data2 の出力設定 !!$ ! Configure the settings for "y_Data2" output !!$ name = 'Data2' !!$ history_filename = trim(#{@arg_keyword} % history_fileprefix) // 'Data2.nc' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ if ( trim(hptr % file) /= '' ) history_filename = trim(hptr % file) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. hptr % history_interval_value > 0.0_DP ) then !!$ !!$ if ( associated( history_work ) ) nullify( history_work ) !!$ !!$ call HstSetXY ( #{@arg_keyword} = #{@arg_keyword}, & ! (inout) !!$ & file = history_filename, hptr = hptr, & ! (in) !!$ & history = history_work, & ! (out) !!$ & xdim = xdim, ydim = ydim, timedim = timedim, & ! (out) !!$ & err = err ) ! (out) !!$ !!$ #{@arg_keyword} % gthist_data2 => history_work !!$ nullify( history_work ) !!$ !!$ call HistoryAddVariable( & !!$ & history = #{@arg_keyword} % gthist_data2, & ! (inout) !!$ & varname = 'Data2', & ! (in) !!$ & dims = StoA(ydim, timedim), & ! (in) !!$ & longname = 'Sample data (2)', & ! (in) !!$ & units = '1', & ! (in) !!$ & xtype = hptr % history_precision ) ! (in) !!$ !!$ 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 '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 !----------------------------------------------------------------- !!$ !------------------------- !!$ ! x_Data1 の出力の終了処理 !!$ ! Terminate the settings for "x_Data1" output !!$ name = 'Data1' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. hptr % history_interval_value > 0.0_DP ) then !!$ call HistoryClose( & !!$ & history = #{@arg_keyword} % gthist_data1 ) ! (inout) !!$ end if !!$ !!$ !------------------------- !!$ ! y_Data2 の出力の終了処理 !!$ ! Terminate the settings for "y_Data2" output !!$ name = 'Data2' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. hptr % history_interval_value > 0.0_DP ) then !!$ call HistoryClose( & !!$ & history = #{@arg_keyword} % gthist_data2 ) ! (inout) !!$ end if !!$ !!$ !----------------------------------------------------------------- !!$ ! ヒストリファイルへのデータ出力設定の割付解除 !!$ ! Deallocate the settings for history data output !!$ !----------------------------------------------------------------- !!$ nullify( hptr ) !!$ deallocate( #{@arg_keyword} % hist_nml ) !!$ deallocate( #{@arg_keyword} % history_varlist_array ) EOF when 'putline' str = <<-EOF !----------------------------------------------------------------- ! "#{@arg_type}" の設定の印字 ! Print the settings for "#{@arg_type}" !----------------------------------------------------------------- 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) // & !!$ & ' @CoefAlpha=%f @DelTime=%f', & !!$ & d = (/#{@arg_keyword} % CoefAlpha, #{@arg_keyword} % DelTime/) ) !!$ call PutLine( #{@arg_keyword} % x_Lon, unit = out_unit, & !!$ & lbounds = lbound(#{@arg_keyword} % x_Lon), & !!$ & ubounds = ubound(#{@arg_keyword} % x_Lon), & !!$ & indent = indent_str(1:indent_len) // & !!$ & ' @x_Lon=' ) !!$ !!$ call PutLine( #{@arg_keyword} % y_Lat, unit = out_unit, & !!$ & lbounds = lbound(#{@arg_keyword} % y_Lat), & !!$ & ubounds = ubound(#{@arg_keyword} % y_Lat), & !!$ & indent = indent_str(1:indent_len) // & !!$ & ' @y_Lat=' ) !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' @history_varlist=%c', & !!$ & c1 = trim( JoinChar(#{@arg_keyword} % history_varlist_array, ',') ) ) !!$ !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' @history_fileprefix=%c', & !!$ & c1 = trim(#{@arg_keyword} % history_fileprefix) ) !!$ !!$ hmax = size( #{@arg_keyword} % hist_nml ) !!$ !!$ do i = 1, hmax !!$ !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' #<#{@arg_type}_HISTNML:: @name=%c @file=%c', & !!$ & c1 = trim(#{@arg_keyword} % hist_nml(i) % name), & !!$ & c2 = trim(#{@arg_keyword} % hist_nml(i) % file) ) !!$ !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' @history_interval_value=%f @history_interval_unit=%c', & !!$ & d = (/#{@arg_keyword} % hist_nml(i) % history_interval_value/), & !!$ & c1 = trim(#{@arg_keyword} % hist_nml(i) % history_interval_unit) ) !!$ !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' @history_precision=%c @history_average=%c', & !!$ & c1 = trim(#{@arg_keyword} % hist_nml(i) % history_precision), & !!$ & l = (/ #{@arg_keyword} % hist_nml(i) % history_average /) ) !!$ !!$ end do !!$ !!$ call Printf( out_unit, & !!$ & indent_str(1:indent_len) // & !!$ & ' >' ) 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 'settime' str = <<-EOF !----------------------------------------------------------------- ! 時刻設定 ! Configure time !----------------------------------------------------------------- !!$ call Create( & !!$ & diff = #{@arg_keyword} % current_time, & ! (out) !!$ & value = current_time_value, & ! (in) !!$ & unit = current_time_unit ) ! (in) !----------------------------------------------------------------- ! ヒストリファイルへのデータの時刻設定 ! Configure the time of history data !----------------------------------------------------------------- !!$ hmax = size( #{@arg_keyword} % hist_nml ) !!$ do i = 1, hmax !!$ #{@arg_keyword} % hist_nml(i) % history_interval_value = - 1.0_DP !!$ call Create( & !!$ & diff = #{@arg_keyword} % hist_nml(i) % history_interval_time, & ! (out) !!$ & value = #{@arg_keyword} % hist_nml(i) % history_interval_value, & ! (in) !!$ & unit = #{@arg_keyword} % hist_nml(i) % history_interval_unit ) ! (in) !!$ end do !!$ !!$ !------------------------- !!$ ! x_Data1 の時刻設定 !!$ ! Configure the time of "x_Data1" !!$ name = 'Data1' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) ) then !!$ call HistorySetTime( & !!$ & history = #{@arg_keyword} % gthist_data1, & ! (inout) !!$ & time = & !!$ & real( EvalbyUnit( #{@arg_keyword} % current_time, & !!$ & hptr % history_interval_unit) ) ) ! (in) !!$ end if !!$ !!$ !------------------------- !!$ ! y_Data2 の時刻設定 !!$ ! Configure the time of "y_Data2" !!$ name = 'Data2' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) ) then !!$ call HistorySetTime( & !!$ & history = #{@arg_keyword} % gthist_data2, & ! (inout) !!$ & time = & !!$ & real( EvalbyUnit( #{@arg_keyword} % current_time, & !!$ & hptr % history_interval_unit) ) ) ! (in) !!$ end if EOF when 'calc' str = <<-EOF !----------------------------------------------------------------- ! *#{@arg_keyword}* に格納されている設定値の取り出し ! Fetch setting values stored in *#{@arg_keyword}* !----------------------------------------------------------------- !!$ CoefAlpha = #{@arg_keyword} % CoefAlpha !!$ DelTime = #{@arg_keyword} % DelTime !----------------------------------------------------------------- ! 時間変化の演算 ! 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' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. & !!$ & ( present_and_true( historyput_flag ) & !!$ & .or. hptr % history_interval_value > 0.0_DP & !!$ & .and. mod( #{@arg_keyword} % current_time, hptr % history_interval_time) == 0 ) ) then !!$ !!$ call HistoryPut( & !!$ & history = #{@arg_keyword} % gthist_data1, & ! (inout) !!$ & varname = 'Data1', array = x_Data1, quiet = .false. ) ! (in) !!$ end if !!$ !!$ !------------------------- !!$ ! y_Data2 の出力 !!$ ! Output "y_Data2" !!$ name = 'Data2' !!$ !!$ call HstNmlAssoc( & !!$ & hist_nml = #{@arg_keyword} % hist_nml, & ! (in) !!$ & name = name, & ! (in) !!$ & hptr = hptr ) ! (out) !!$ !!$ if ( StrInclude( #{@arg_keyword} % history_varlist_array, name ) & !!$ & .and. & !!$ & ( present_and_true( historyput_flag ) & !!$ & .or. hptr % history_interval_value > 0.0_DP & !!$ & .and. mod( #{@arg_keyword} % current_time, hptr % history_interval_time) == 0 ) ) then !!$ !!$ call HistoryPut( & !!$ & history = #{@arg_keyword} % gthist_data2, & ! (inout) !!$ & varname = 'Data2', array = y_Data2, quiet = .false. ) ! (in) !!$ end if !----------------------------------------------------------------- ! 時刻の更新 ! Update time !----------------------------------------------------------------- !!$ #{@arg_keyword} % current_time = & !!$ & #{@arg_keyword} % current_time + #{@arg_keyword} % delta_time EOF when 'nmlread' str = <<-EOF !----------------------------------------------------------------- ! 文字型引数を NAMELIST 変数群へ代入 ! Substitute character arguments to NAMELIST group !----------------------------------------------------------------- !!$ history_varlist = history_varlist_ !!$ history_fileprefix = history_fileprefix_ !---------------------------------------------------------------- ! 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, 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 list of output variables !!$ rewind( unit_nml ) !!$ read( unit = unit_nml, & ! (in) !!$ & nml = #{@mod_name}_varlist_nml, iostat = iostat_nml ) ! (out) !!$ if ( iostat_nml == 0 ) then !!$ call MessageNotify( 'M', subname, & !!$ & 'NAMELIST group "%c" is loaded from "%c".', & !!$ & c1='#{@mod_name}_varlist_nml', c2=trim(nmlfile) ) !!$ write(STDOUT, nml = #{@mod_name}_varlist_nml) !!$ else !!$ call MessageNotify( 'W', subname, & !!$ & 'NAMELIST group "%c" is not found in "%c" (iostat=%d).', & !!$ & c1='#{@mod_name}_varlist_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 = '' !!$ history_interval_value = hist_nml(1) % history_interval_value !!$ history_interval_unit = hist_nml(1) % history_interval_unit !!$ history_precision = hist_nml(1) % history_precision !!$ history_average = hist_nml(1) % history_average !!$ !!$ read( unit = unit_nml, & ! (in) !!$ & nml = #{@mod_name}_history_nml, iostat = iostat_nml ) ! (out) !!$ inquire( 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) !!$ !!$ if ( name == '' ) then !!$ hist_nml(1) % name = name !!$ hist_nml(1) % file = '' !!$ hist_nml(1) % history_interval_value = history_interval_value !!$ hist_nml(1) % history_interval_unit = history_interval_unit !!$ hist_nml(1) % history_precision = history_precision !!$ hist_nml(1) % history_average = history_average !!$ !!$ call Create( & !!$ & diff = hist_nml(1) % history_interval_time, & ! (out) !!$ & value = history_interval_value, & ! (in) !!$ & unit = history_interval_unit ) ! (in) !!$ !!$ elseif ( file /= '' ) then !!$ hmax = size( hist_nml ) !!$ allocate( hist_nml_work(hmax) ) !!$ hist_nml_work = hist_nml !!$ deallocate( hist_nml ) !!$ allocate( hist_nml(hmax+1) ) !!$ hist_nml(1:hmax) = hist_nml_work !!$ deallocate( hist_nml_work ) !!$ !!$ if ( trim(history_varlist) /= '' ) history_varlist = trim( history_varlist ) // ',' !!$ history_varlist = trim( history_varlist ) // trim(name) !!$ !!$ hist_nml(hmax+1) % name = name !!$ hist_nml(hmax+1) % file = file !!$ hist_nml(hmax+1) % history_interval_value = history_interval_value !!$ hist_nml(hmax+1) % history_interval_unit = history_interval_unit !!$ hist_nml(hmax+1) % history_precision = history_precision !!$ hist_nml(hmax+1) % history_average = history_average !!$ !!$ call Create( & !!$ & diff = hist_nml(hmax+1) % history_interval_time, & ! (out) !!$ & value = history_interval_value, & ! (in) !!$ & unit = history_interval_unit ) ! (in) !!$ !!$ end if !!$ !!$ 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 !----------------------------------------------------------------- !!$ history_varlist_ = history_varlist !!$ history_fileprefix_ = history_fileprefix EOF when 'hstnmlassoc' str = <<-EOF !----------------------------------------------------------------- ! *hist_nml* に格納される, *name* に該当するデータへ結合 ! Associate information of data correspond to *name* ! stored in pointer array *hist_nml* !----------------------------------------------------------------- !!$ hmax = size( hist_nml ) !!$ !!$ if ( associated(hptr) ) nullify( hptr ) !!$ do i = 1, hmax !!$ if ( trim(hist_nml(i) % name) == trim(name) ) & !!$ & hptr => hist_nml(i) !!$ end do !!$ if ( .not. associated(hptr) ) hptr => hist_nml(1) EOF when 'hstsetxy' str = <<-EOF !----------------------------------------------------------------- ! これまでにオープンされたファイルのチェック ! Check already opened files !----------------------------------------------------------------- !※ HistoryInquire でファイル名が一致していることをチェック !※ HistoryInquire と hptr との内部情報の比較から, ! origin, interval, 時刻の単位が一致することをチェック ! ! 上記チェックが通れば, その gthist に結合. ! ファイルのみが一致し, それ以外が一致しない場合はエラーを返す. ! ファイル名が一致しない場合, 下記のように allocate を行い, ! リスト構造になっている ***_HISTLIST の要素を増やしてそちらから ! 作成済みの変数に結合する. !!$ if ( associated( history ) ) nullify( history ) !!$ allocate( history ) !----------------------------------------------------------------- ! 軸の名称の設定 ! Configure names of axes !----------------------------------------------------------------- !!$ xdim = 'lon' !!$ ydim = 'lat' !!$ timedim = 'time' !----------------------------------------------------------------- ! HistoryCreate によるファイル作成 ! Files are created by "HistoryCreate" !----------------------------------------------------------------- !!$ call HistoryCreate( & !!$ & history = history, & ! (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(xdim, ydim, timedim), & ! (in) !!$ & dimsizes = (/#{@arg_keyword} % imax, #{@arg_keyword} % jmax, 0/), & ! (in) !!$ & longnames = StoA('longitude', 'latitude', 'time'), & ! (in) !!$ & units = StoA('degree_east', 'degree_north', & !!$ & hptr % history_interval_unit), & ! (in) !!$ & origin = real(EvalbyUnit(#{@arg_keyword} % current_time, & !!$ & hptr % history_interval_unit)), & ! (in) !!$ & interval = real(EvalbyUnit(hptr % history_interval_time, & !!$ & hptr % history_interval_unit)) ) ! (in) !!$ !!$ call HistoryAddAttr( & !!$ & history = history, & ! (inout) !!$ & varname = xdim, attrname = 'standard_name', & ! (in) !!$ & value = 'longitude' ) ! (in) !!$ call HistoryAddAttr( & !!$ & history = history, & ! (inout) !!$ & varname = ydim, attrname = 'standard_name', & ! (in) !!$ & value = 'latitude' ) ! (in) !!$ !!$ call HistoryPut( & !!$ & history = history, & ! (inout) !!$ & varname = xdim, & ! (in) !!$ & array = #{@arg_keyword} % x_Lon / PI * 180.0_DP ) ! (in) !!$ call HistoryPut( & !!$ & history = history, & ! (inout) !!$ & varname = ydim, & ! (in) !!$ & array = #{@arg_keyword} % y_Lat / PI * 180.0_DP ) ! (in) EOF else str = <<-EOF !----------------------------------------------------------------- ! *#{@arg_keyword}* に格納されている設定値の取り出し ! Fetch setting values stored in *#{@arg_keyword}* !----------------------------------------------------------------- !!$ CoefAlpha = #{@arg_keyword} % CoefAlpha !!$ DelTime = #{@arg_keyword} % DelTime 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 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}, Create, Close, & & PutLine, initialized, Calculation, 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, Open, HelpMsg, Option, Debug, Help, Strict, Close implicit none !------------------------------------------------------------------- ! 実験の表題, モデルの名称, 所属機関名 ! Title of a experiment, name of model, sub-organ !------------------------------------------------------------------- character(*), parameter:: title = & & '#{@program_name} $Name: dcpam4-20071012 $ :: ' // & & '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 arguments 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, #{@mod_arg_keyword}02, #{@mod_arg_keyword}03, #{@mod_arg_keyword}04 logical:: err character(*), parameter:: subname = '#{@program_name}' continue !------------------------------------------------------------------- ! コマンドライン引数の処理 ! 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 ) !------------------------------------------------------------------- ! 軸データの設定 ! 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 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 AssertEqual( 'basic initialization test 1', & & answer = .true., check = initialized(#{@mod_arg_keyword}00) ) call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (inout) call AssertEqual( 'basic termination test 1', & & answer = .false., check = initialized(#{@mod_arg_keyword}00) ) call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) !------------------------------------------------------------------- ! 重複初期設定に関するエラー処理のテスト ! Error handling related to duplicated initialization test !------------------------------------------------------------------- call 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 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 PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (in) call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00 ) ! (inout) !------------------------------------------------------------------- ! 終了処理に関するエラー処理のテスト ! Error handling related to termination test !------------------------------------------------------------------- call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}00, & ! (inout) & err = err ) call AssertEqual( 'error handling related to termination test 1', & & answer = .true., check = err ) !------------------------------------------------------------------- ! 無効な値に関するエラー処理のテスト ! Error handling related to invalid values test !------------------------------------------------------------------- !!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}01, & ! (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 1', & !!$ & answer = .true., check = err ) !!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}01, & ! (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 ) !------------------------------------------------------------------- ! NAMELIST ファイルの読み込みテスト ! NAMELIST file loading test !------------------------------------------------------------------- call 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) & nmlfile = VAL_namelist ) ! (in) call AssertEqual( 'NAMELIST file loading test 1', & & answer = .true., check = initialized(#{@mod_arg_keyword}02) ) call PutLine( #{@mod_arg_keyword} = #{@mod_arg_keyword}02 ) ! (in) call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}02 ) ! (inout) !------------------------------------------------------------------- ! ヒストリデータ出力テスト ! History data output test !------------------------------------------------------------------- !!$ call Create( #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & 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_DP, & ! (in) !!$ & current_time_unit = 'sec', & ! (in) !!$ & history_varlist = 'Data2', & ! (in) !!$ & history_interval_value = 2.0_DP, & ! (in) !!$ & history_interval_unit = 'sec', & ! (in) !!$ & history_precision = 'float', & ! (in) !!$ & history_fileprefix = 'AP_' ) ! (in) !!$ call 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 Calculation( #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & x_Data1 = x_Data1, y_Data2 = y_Data2 ) ! (inout) !!$ end do !!$ !!$ call SetTime( #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & current_time_value = 1.0_DP, current_time_unit = 'minute' ) ! (in) !!$ !!$ call Calculation( #{@mod_arg_keyword} = #{@mod_arg_keyword}03, & ! (inout) !!$ & x_Data1 = x_Data1, y_Data2 = y_Data2, & ! (inout) !!$ & historyput_flag = .true. ) ! (in) !!$ !!$ call Close( #{@mod_arg_keyword} = #{@mod_arg_keyword}03 ) ! (inout) 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.0005 ! $ \\alpha $ . 係数. Coefficient / &#{@mod_name}_history_nml history_interval_value=5.0, ! ヒストリデータの出力間隔の数値. ! Numerical value for interval of history data output history_interval_unit='sec', ! ヒストリデータの出力間隔の単位. ! Unit for interval of history data output history_precision='double', ! ヒストリデータの精度. ! Precision of history data history_fileprefix='NP_' ! ヒストリデータのファイル名の接頭詞. ! Prefix of history data filenames / &#{@mod_name}_history_nml name='Data1', ! 変数名. Variable name file='NPI_Data1.nc' ! 出力ファイル名. ! Output file name / &#{@mod_name}_varlist_nml history_varlist='Data2' ! ヒストリデータの出力変数リスト. ! カンマで区切って並べる. ! (例: "Data1,Data2" ). ! ! List of variables output to history data. ! Delimiter is comma. ! (exp. "Data1,Data2" ). ! / 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