#!/usr/bin/env ruby # -*- f90 -*- # vi: set sw=4 ts=8: require("lib-rb2f90-macro") require("optparse") # # "gtvargetnum.f90" Generator with Ruby. # print <<"__EndOfFortran90Code__" !-- #{rb2f90_header_comment}! !++ ! != 固定長配列への数値データの入力 ! ! Authors:: Yasuhiro MORIKAWA, Eizi TOYODA ! Version:: $Id: gtvargetnum.rb2f90,v 1.5 2009-05-25 09:55:58 morikawa Exp $ ! Tag Name:: $Name: gtool5-20100413 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! ! 以下のサブルーチン、関数は gtdata_generic から gtdata_generic#Get ! として提供されます。 __EndOfFortran90Code__ types = ["Double", "Real", "Int"] types.each{ |type| print <<"__EndOfFortran90Code__" subroutine GTVarGet#{type}(var, value, nvalue, err) ! #{ifelse(type, "Double", %Q{ ! !== 固定長配列への数値データの入力 ! ! 変数 *var* から *value* に数値データが入力されます。 ! *nvalue* には配列長を代入する必要があります。 ! ! 数値データ入力の際にエラーが生じた場合、メッセージを出力 ! してプログラムは強制終了します。*err* を与えてある場合には ! の引数に .true. が返り、プログラムは終了しません。 ! ! 入力しようとするデータの型が引数の型と異なる場合、データは引数の ! 型に変換されます。 この変換は netCDF の機能を用いています。 ! 詳しくは {netCDF 日本語版マニュアル}[link:../xref.htm#label-10] ! の 3.3 型変換 を参照してください。 ! ! *Get* は複数のサブルーチンの総称名であり、 ! *value* にポインタ型の配列を与えることも可能です。上記の ! サブルーチンを参照してください。 ! })} ! use gtdata_types, only: GT_VARIABLE use gtdata_internal_map, only: var_class, vtb_class_netcdf, & & map_to_internal_specs, gtvar_dump use gtdata_netcdf_generic, only: Get use gtdata_netcdf_types, only: GD_NC_VARIABLE use dc_types, only: DP, STRING use dc_trace, only: BeginSub, EndSub use dc_error, only: StoreError, DC_NOERR, DC_ENEGATIVE, GT_EFAKE implicit none type(GT_VARIABLE), intent(in) :: var #{$type_intent_out[type]}, intent(out) :: value(*) integer, intent(in) :: nvalue logical, intent(out), optional:: err integer :: class, cid, stat integer , pointer :: specs(:, :) character(STRING):: cause_c character(len = *), parameter:: subname = 'GTVarGet#{type}' continue call var_class(var, class, cid) call BeginSub(subname, 'nvalue=%d', i=(/nvalue/)) stat = DC_NOERR cause_c = '' if (nvalue < 1) then stat = DC_ENEGATIVE cause_c = 'nvalue' goto 999 end if call gtvar_dump(var) call map_to_internal_specs(var, specs) if (class == vtb_class_netcdf) then call Get(GD_NC_VARIABLE(cid), start=specs(:, 1), count=specs(:, 2), & & stride=specs(:, 3), imap=specs(:, 4), siz=nvalue, value=value, & & iostat=stat) else stat = GT_EFAKE endif if (associated(specs)) deallocate(specs) 999 continue call StoreError(stat, subname, cause_c = cause_c, err = err) call EndSub(subname, 'stat=%d', i=(/stat/)) end subroutine GTVarGet#{type} __EndOfFortran90Code__ } print <<"__EndOfFooter__" !-- ! vi:set readonly sw=4 ts=8: ! #{rb2f90_emacs_readonly}! !++ __EndOfFooter__