| Class | varinfo_mod |
| In: |
varinfo/varinfo.f90
|
Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!=begin
* Developers: Morikawa Yasuhiro * Version: $Id: varinfo.f90,v 1.8 2005/01/19 08:52:45 morikawa Exp $ * Tag Name: $Name: $ * Change History:
This module store Variable Infomation from NAMELIST and Provide. These Information is expected to be used by ((< io_gt4_out_mod >)). NAMELIST から出力する変数に関する情報を取得する。 これらの情報は ((< io_gt4_out_mod >)) にて用いられることが想定されている。
もしかすると、((< io_gt4_out_mod >)) モジュール内に格納される べきかも知れません。
!=end
varinfo_mod の内部サブルーチン。 構造体 ((<GT_HISTORY_ATTR|URL:www.gfd-dennou.org/arch/gtool4/gt4f90io-current/doc/gt_history.htm#derived_gthistoryattr>)) の1次元配列のコピーを行なう。
subroutine varinfo_attrs_copy (from, to)
!==== Dependency
use type_mod, only: STRING, INTKIND
use gt4_history, only: GT_HISTORY_ATTR
use dc_trace, only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== Input
!
type(GT_HISTORY_ATTR), intent(in) :: from(:)
!
!==== Output
!
type(GT_HISTORY_ATTR), intent(out) :: to(:)
!=end
integer(INTKIND) :: i
character(STRING), parameter:: subname = "varinfo_attrs_copy"
continue
call BeginSub(subname)
call DbgMessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', &
& i=(/ size(from), size(to), min(size(from),size(to)) /) )
do i = 1, min( size(from), size(to) )
call DbgMessage('from(%d) [attrname=<%c> ' // &
& 'attrtype=<%c> array=<%b> cvalue=<%c> ' // &
& 'ivalue=<%d> rvalue=<%r> dvalue=<%f> ' // &
& 'iarray(1:%d)=<%d, ...> ' // &
& 'rarray(1:%d)=<%r, ...> darray(1:%d)=<%f, ...>' , &
& c1=trim( from(i)%attrname ) , &
& c2=trim( from(i)%attrtype ) , &
& c3=trim( from(i)%cvalue ) , &
& i=(/ i, from(i)%ivalue , &
& size(from(i)%iarray) , &
& from(i)%iarray , &
& size(from(i)%rarray) , &
& size(from(i)%darray) &
& /) , &
& r=(/from(i)%rvalue, from(i)%rarray/) , &
& d=(/from(i)%dvalue, from(i)%darray/) , &
& l=(/from(i)%lvalue/) )
allocate( to(i)%iarray( size(from(i)%iarray) ) )
allocate( to(i)%rarray( size(from(i)%rarray) ) )
allocate( to(i)%darray( size(from(i)%darray) ) )
to(i)%attrname = from(i)%attrname
to(i)%attrtype = from(i)%attrtype
to(i)%array = from(i)%array
to(i)%cvalue = from(i)%cvalue
to(i)%ivalue = from(i)%ivalue
to(i)%rvalue = from(i)%rvalue
to(i)%dvalue = from(i)%dvalue
to(i)%lvalue = from(i)%lvalue
to(i)%iarray(:) = from(i)%iarray(:)
to(i)%rarray(:) = from(i)%rarray(:)
to(i)%darray(:) = from(i)%darray(:)
enddo
call EndSub(subname)
end subroutine
varinfo_mod の内部サブルーチン。 構造体 ((<GT_HISTORY_ATTR|URL:www.gfd-dennou.org/arch/gtool4/gt4f90io-current/doc/gt_history.htm#derived_gthistoryattr>)) 変数の初期化を行なう。
subroutine varinfo_attrs_init0 (attrs)
!==== Dependency
use type_mod, only: STRING, INTKIND
use gt4_history, only: GT_HISTORY_ATTR
use dc_trace, only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== In/Out
!
type(GT_HISTORY_ATTR), intent(inout):: attrs
!=end
character(STRING), parameter:: subname = "varinfo_attrs_init0"
continue
call BeginSub(subname)
allocate( attrs%iarray( 1 ) )
allocate( attrs%rarray( 1 ) )
allocate( attrs%darray( 1 ) )
attrs%attrname = ''
attrs%attrtype = ''
attrs%array = .false.
attrs%cvalue = ''
attrs%ivalue = 0
attrs%rvalue = 0.0
attrs%dvalue = 0.0d0
attrs%lvalue = .false.
attrs%iarray(:) = 0
attrs%rarray(:) = 0.0
attrs%darray(:) = 0.0d0
call DbgMessage('Initialize attrs [attrname=<%c> ' // &
& 'attrtype=<%c> array=<%b> cvalue=<%c> ' // &
& 'ivalue=<%d> rvalue=<%r> dvalue=<%f> ' // &
& 'iarray(1:%d)=<%d, ...> ' // &
& 'rarray(1:%d)=<%r, ...> darray(1:%d)=<%f, ...>' , &
& c1=trim( attrs%attrname ) , &
& c2=trim( attrs%attrtype ) , &
& c3=trim( attrs%cvalue ) , &
& i=(/ attrs%ivalue , &
& size(attrs%iarray) , &
& attrs%iarray , &
& size(attrs%rarray) , &
& size(attrs%darray) &
& /) , &
& r=(/attrs%rvalue, attrs%rarray/) , &
& d=(/attrs%dvalue, attrs%darray/) , &
& l=(/attrs%lvalue/) )
call EndSub(subname)
end subroutine
varinfo_mod の内部サブルーチン。 構造体 ((<GT_HISTORY_ATTR|URL:www.gfd-dennou.org/arch/gtool4/gt4f90io-current/doc/gt_history.htm#derived_gthistoryattr>)) の1次元配列の初期化を行なう。
subroutine varinfo_attrs_init1 (attrs)
!==== Dependency
use type_mod, only: STRING, INTKIND
use gt4_history, only: GT_HISTORY_ATTR
use dc_trace, only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== In/Out
!
type(GT_HISTORY_ATTR), intent(inout):: attrs(:)
!=end
integer(INTKIND) :: i
character(STRING), parameter:: subname = "varinfo_attrs_init1"
continue
call BeginSub(subname)
call DbgMessage('size(attrs)=<%d>' , i=(/size(attrs)/) )
do i = 1, size(attrs)
call varinfo_attrs_init(attrs(i))
enddo
call EndSub(subname)
end subroutine
varinfo_mod の内部サブルーチン。 構造体 ((< VAR_INFO >)) の1次元配列のコピーを行なう。
subroutine varinfo_copy (from, to)
!==== Dependency
use type_mod , only: STRING, INTKIND
use dc_trace , only: BeginSub, EndSub, DbgMessage
!=end
implicit none
!=begin
!==== Input
!
type(VAR_INFO), intent(in) :: from(:)
!
!==== Output
!
type(VAR_INFO), intent(out) :: to(:)
!=end
integer(INTKIND) :: i
character(STRING), parameter:: subname = "varinfo_copy"
continue
call BeginSub(subname)
call DbgMessage('size(from)=<%d>, size(to)=<%d>, So copy <%d> times.', &
& i=(/ size(from), size(to), min(size(from),size(to)) /) )
do i = 1, min( size(from), size(to) )
call DbgMessage('from(%d) [varkey=<%c> ' // &
& 'file=<%c> varinfo-name=<%c>]' , &
& c1=trim( from(i)%varkey ) , &
& c2=trim( from(i)%file ) , &
& c3=trim( from(i)%varinfo%name ) , &
& i=(/ i /) )
to(i)%varkey = from(i)%varkey
to(i)%file = from(i)%file
to(i)%StepInterval = from(i)%StepInterval
to(i)%OutputStep = from(i)%OutputStep
to(i)%varinfo%name = from(i)%varinfo%name
to(i)%varinfo%longname = from(i)%varinfo%longname
to(i)%varinfo%units = from(i)%varinfo%units
to(i)%varinfo%xtype = from(i)%varinfo%xtype
if ( allocated(to(i)%varinfo%dims) ) then
deallocate( to(i)%varinfo%dims )
endif
if ( allocated(from(i)%varinfo%dims) ) then
allocate( to(i)%varinfo%dims( size(from(i)%varinfo%dims) ) )
to(i)%varinfo%dims(:) = from(i)%varinfo%dims(:)
endif
if ( allocated(to(i)%attrs) ) then
deallocate( to(i)%attrs )
endif
if ( allocated(from(i)%attrs) ) then
allocate( to(i)%attrs( size(from(i)%attrs) ) )
call varinfo_attrs_copy( from(i)%attrs(:), to(i)%attrs(:) )
endif
enddo
call EndSub(subname)
end subroutine
変数キー varkey に対応する変数情報 info を返す。 stat にはステータスを返す。正常に変数情報が返れば 0, varkey に対応する情報が無ければ 1, ((< varinfo_init >)) による初期化が行なわれていない場合は -1 を返す。
subroutine varinfo_inquire (varkey, info, stat)
!==== Dependency
use type_mod, only: STRING, TOKEN, INTKIND, REKIND, DBKIND
use dc_trace, only: DbgMessage, BeginSub, EndSub
use dc_error, only: StoreError, USR_ECHAR
!=end
implicit none
!=begin
!==== Input
!
character(*), intent(in) :: varkey ! 変数キー
!
!==== Output
!
type(VAR_INFO), intent(out) :: info ! VAR_INFO 変数
integer(INTKIND), intent(out) :: stat ! ステータス
!=end
integer(INTKIND) :: i
character(STRING), parameter:: subname = "varinfo_inquire"
continue
!-----------------------------------------------------------------
! Check Initialization
!-----------------------------------------------------------------
call BeginSub( subname )
if (.not. varinfo_initialized) then
stat = -1
call EndSub( subname, 'Call varinfo_init before call %c. status=<%d>', &
& c1=trim(subname), i=(/stat/) )
return
endif
!----------------------------------------------------------------
! vars_store 内から、varkey に該当するものを探査する。
!----------------------------------------------------------------
do i = 1, size( vars_store )
! varkey に該当するものが見つかったらそれを info に返す。
if ( trim(vars_store(i)%varkey) == trim(varkey) ) then
info = vars_store(i)
stat = 0
call EndSub( subname, 'varkey=<%c> is found. status=<%d>', &
& c1=trim(varkey), i=(/stat/) )
return
endif
enddo
!----------------------------------------------------------------
! varkey に該当するものが無い場合は stat = 1 として返す。
!----------------------------------------------------------------
stat = 1
call EndSub( subname, 'varkey=<%c> is not found. status=<%d>', &
& c1=trim(varkey), i=(/stat/) )
end subroutine