!--
! *** Caution!! ***
!
! This file is generated from "dc_string.rb2f90" by Ruby 1.8.5.
! Please do not edit this file directly.
!
! [JAPANESE]
!
! 窶ｻ窶ｻ窶ｻ 豕ｨ諢�!!! 窶ｻ窶ｻ窶ｻ
!
! 縺薙�繝輔ぃ繧､繝ｫ縺ｯ "dc_string.rb2f90" 縺九ｉ Ruby 1.8.5
! 縺ｫ繧医▲縺ｦ閾ｪ蜍慕函謌舌＆繧後◆繝輔ぃ繧､繝ｫ縺ｧ縺�.
! 縺薙�繝輔ぃ繧､繝ｫ繧堤峩謗･邱ｨ髮�＠縺ｾ縺帙ｓ繧医≧縺企｡倥＞閾ｴ縺励∪縺�.
!
!
!++
!
!= 譁�ｭ怜梛螟画焚縺ｮ謫堺ｽ�
!
!= character type support routines
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: dc_string.f90,v 1.2 2009-10-12 06:54:43 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!

module dc_string
  !
  != 譁�ｭ怜梛螟画焚縺ｮ謫堺ｽ�
  !
  != character type support routines
  !
  ! <b>Note that Japanese and English are described in parallel.</b>
  !
  ! dc_string 縺ｯ譁�ｭ怜�繧呈桃菴懊☆繧九◆繧√�繧ｵ繝悶Ν繝ｼ繝√Φ鄒､繧�
  ! 謠蝉ｾ帙☆繧九Δ繧ｸ繝･繝ｼ繝ｫ縺ｧ縺�.
  !
  ! 'dc_string' module provides character type support routines
  !
  !== Procedures List
  !
  ! StoI           :: 譁�ｭ怜梛繧呈紛謨ｰ蝙九↓螟画鋤
  ! StoD           :: 譁�ｭ怜梛繧貞咲ｲｾ蠎ｦ螳滓焚蝙九↓螟画鋤
  ! StoA           :: 譁�ｭ怜梛繧呈枚蟄怜梛驟榊�縺ｫ螟画鋤
  ! Get_Array      :: 譁�ｭ怜梛繧呈紛謨ｰ蝙矩�蛻励∝腰邊ｾ蠎ｦ螳滓焚蝙矩�蛻励∝咲ｲｾ蠎ｦ螳滓焚蝙矩�蛻励↓螟画鋤
  ! Str_to_Logical :: 譁�ｭ怜梛繧定ｫ也炊蝙九↓螟画鋤
  ! toChar         :: 謨ｰ蛟､蝙九∬ｫ也炊蝙九ｒ譁�ｭ怜梛縺ｫ螟画鋤
  ! Split          :: 譁�ｭ怜�縺ｮ蛻�牡
  ! JoinChar       :: 譁�ｭ怜梛驟榊�縺ｮ騾｣邨�
  ! Concat         :: 譁�ｭ怜梛驟榊�縺ｮ譛ｫ蟆ｾ縺ｫ譁�ｭ励ｒ騾｣邨�
  ! Index_Ofs      :: 繧ｪ繝輔そ繝�ヨ譁�ｭ怜�荳ｭ縺ｮ譁�ｭ鈴Κ蛻��縺ｮ髢句ｧ倶ｽ咲ｽｮ繧呈爾譟ｻ. (Index 髢｢謨ｰ縺ｮ諡｡蠑ｵ迚�)
  ! Replace        :: 譁�ｭ怜�鄂ｮ謠�
  ! toUpper        :: 譁�ｭ怜�繧貞､ｧ譁�ｭ励∈螟画鋤 (繧ｵ繝悶Ν繝ｼ繝√Φ)
  ! UChar          :: 譁�ｭ怜�繧貞､ｧ譁�ｭ励∈螟画鋤 (髢｢謨ｰ)
  ! toLower        :: 譁�ｭ怜�繧貞ｰ乗枚蟄励∈螟画鋤 (繧ｵ繝悶Ν繝ｼ繝√Φ)
  ! LChar          :: 譁�ｭ怜�繧貞ｰ乗枚蟄励∈螟画鋤 (髢｢謨ｰ)
  ! StriEq         :: 譁�ｭ怜�縺ｮ豈碑ｼ� (螟ｧ譁�ｭ怜ｰ乗枚蟄励ｒ辟｡隕�)
  ! StrHead        :: 譁�ｭ怜�縺ｮ豈碑ｼ� (蜈磯�ｭ驛ｨ蛻��縺ｿ縺ｮ豈碑ｼ�)
  ! StrInclude     :: 譁�ｭ怜梛驟榊�蜀��讀懈渊
  ! CPrintf        :: 繝��繧ｿ繧呈紛蠖｢縺励※譁�ｭ怜�縺ｨ縺励※霑斐☆
  ! Printf         :: 繝��繧ｿ繧呈紛蠖｢縺励※蜃ｺ蜉�
  ! PutLine        :: 謨ｰ蛟､蝙矩�蛻励�隕∫ｴ�ｒ蜊ｰ蟄�
  ! RoundNum       :: 遶ｯ謨ｰ縺ｮ謨ｴ蠖｢蜃ｦ逅�
  !------------    :: ------------
  ! StoI           :: Convert character type into integer type
  ! StoD           :: Convert character type into double precision real type
  ! StoA           :: Convert character type into character type array
  ! Get_Array      :: Convert character type into integer type array, or
  !                   single precision real type array, or
  !                   double precision real type array
  ! Str_to_Logical :: Convert character type into logical type
  ! toChar         :: Convert numerical types or logical type
  !                   into character type
  ! Split          :: Split character type
  ! JoinChar       :: Join characters in character type array, and
  !                   convert them into character type variable
  ! Concat         :: Concatenate character type to end of character type array
  ! Index_Ofs      :: Search start position of partial character on offset character (extended 'index' function)
  ! Replace        :: Replace character
  ! toUpper        :: Uppercase character (Subroutine)
  ! UChar          :: Uppercase character (Function)
  ! toLower        :: Lowercase character (Subroutine)
  ! LChar          :: Lowercase character (Function)
  ! StriEq         :: Compare two characters (not case-sensitive)
  ! StrHead        :: Compare headers of two characters
  ! StrInclude     :: Search in character type array
  ! CPrintf        :: Format an return data
  ! Printf         :: Format an print data
  ! PutLine        :: Print summary of numerical array
  ! RoundNum       :: Form about fraction

  use dc_types, only: TOKEN, STRING, DP
  implicit none
  private

  !-------------------------------------
  !  譁�ｭ励°繧画焚蛟､縺ｸ縺ｮ螟画鋤
  public:: StoI
  interface StoI
    module procedure atoi_scalar
  end interface

  public:: StoD
  interface StoD
    module procedure atod_scalar
  end interface

  public:: get_array
  interface get_array
    module procedure str2ip
    module procedure str2rp
    module procedure str2dp
  end interface

  public:: Str_to_Logical
  interface Str_to_Logical
    module procedure str2bool
  end interface

  !-------------------------------------
  !  謨ｰ蛟､縺九ｉ譁�ｭ励∈縺ｮ螟画鋤
  public:: toChar
  interface toChar
    module procedure itoa_scalar
    module procedure itoa_array
    module procedure rtoa_scalar
    module procedure rtoa_array
    module procedure dtoa_scalar
    module procedure dtoa_array
    module procedure ltoa_scalar
    module procedure ltoa_array
  end interface

  !-------------------------------------
  !  謨ｰ蛟､陦ｨ險倥�譁�ｭ怜�縺ｮ遶ｯ謨ｰ髯､蜴ｻ
  public:: RoundNum
  interface RoundNum
    module procedure RoundNum
  end interface

  !-------------------------------------
  !  譁�ｭ怜梛驟榊�縺ｮ騾｣邨�
  public:: JoinChar

  !-------------------------------------
  !  譁�ｭ怜梛驟榊�縺ｮ譛ｫ蟆ｾ縺ｫ譁�ｭ励ｒ騾｣邨�
  public:: Concat
  interface Concat
    module procedure concat_tail
  end interface

  !-------------------------------------
  !  髟ｷ縺輔�逡ｰ縺ｪ繧区枚蟄礼ｾ､縺ｮ驟榊�蛹�
  public :: StoA
  interface StoA
    module procedure Str_to_Array1
    module procedure Str_to_Array2
    module procedure Str_to_Array3
    module procedure Str_to_Array4
    module procedure Str_to_Array5
    module procedure Str_to_Array6
    module procedure Str_to_Array7
    module procedure Str_to_Array8
    module procedure Str_to_Array9
    module procedure Str_to_Array10
    module procedure Str_to_Array11
    module procedure Str_to_Array12
  end interface

  !-------------------------------------
  !  譁�ｭ怜�縺ｮ蛻�ｧ｣
  public Split
  interface Split
    module procedure Split_CC
  end interface

  !-------------------------------------
  !  譁�ｭ怜�縺ｮ隗｣譫�
  public:: Index_Ofs
  interface Index_Ofs
    module procedure Index_Ofs
  end interface

  public:: Replace
  interface Replace
    module procedure Replace
  end interface

  !-------------------------------------
  !  螟ｧ譁�ｭ励�蟆乗枚蟄励ｒ辟｡隕悶＠縺溷�逅�
  public:: toUpper
  interface toUpper
    module procedure cupper
  end interface

  public:: toLower
  interface toLower
    module procedure clower
  end interface

  public:: UChar
  interface UChar
    module procedure UChar
  end interface

  public:: LChar
  interface LChar
    module procedure LChar
  end interface

  public:: StriEq
  interface StriEq
    module procedure StriEq_cc
  end interface

  public:: StrHead
  interface StrHead
    module procedure strhead_cc
  end interface

  public:: StrInclude
  interface StrInclude
    module procedure str_include_ac
  end interface

  !-------------------------------------
  !  蜊ｰ蟄励�縺溘ａ縺ｮ譁�ｭ怜�逅�
  public:: GTStringQuoteForDcl
  interface
    function GTStringQuoteForDcl(string) result(result)
      use dc_types, only: STRLEN => STRING
      character(*), intent(in):: string
      character(STRLEN):: result
    end function GTStringQuoteForDcl
  end interface

  public:: CPrintf
  interface CPrintf

    function DCStringCPrintf(fmt, i, r, d, L, n, c1, c2, c3, ca) result(result)
      use dc_types, only: STRING, DP
      character(len = STRING):: result
      character(*), intent(in):: fmt
      integer, intent(in), optional:: i(:), n(:)
      real, intent(in), optional:: r(:)
      real(DP), intent(in), optional:: d(:)
      logical, intent(in), optional:: L(:)
      character(*), intent(in), optional:: c1, c2, c3
      character(*), intent(in), optional:: ca(:)
    end function DCStringCPrintf

  end interface

  public:: Printf
  interface Printf

    subroutine DCStringSPrintf(unit, fmt, i, r, d, L, n, c1, c2, c3, ca)
      use dc_types, only: DP
      character(*), intent(out):: unit
      character(*), intent(in):: fmt
      integer, intent(in), optional:: i(:), n(:)
      real, intent(in), optional:: r(:)
      real(DP), intent(in), optional:: d(:)
      logical, intent(in), optional:: L(:)
      character(*), intent(in), optional:: c1, c2, c3
      character(*), intent(in), optional:: ca(:)
    end subroutine DCStringSPrintf

    subroutine DCStringFPrintf(unit, fmt, i, r, d, L, n, c1, c2, c3, ca)
      use dc_types, only: DP
      integer, intent(in), optional:: unit
      character(*), intent(in):: fmt
      integer, intent(in), optional:: i(:), n(:)
      real, intent(in), optional:: r(:)
      real(DP), intent(in), optional:: d(:)
      logical, intent(in), optional:: L(:)
      character(*), intent(in), optional:: c1, c2, c3
      character(*), intent(in), optional:: ca(:)
    end subroutine DCStringFPrintf

  end interface

  !-------------------------------------
  !  謨ｰ蛟､蝙矩�蛻励�隕∫ｴ�魂蟄�
  public:: PutLine
  interface PutLine

    subroutine PutLineInt1( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:)
      integer, intent(in), optional:: lbounds(1)
      integer, intent(in), optional:: ubounds(1)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt1

    subroutine PutLineInt2( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:)
      integer, intent(in), optional:: lbounds(2)
      integer, intent(in), optional:: ubounds(2)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt2

    subroutine PutLineInt3( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:,:)
      integer, intent(in), optional:: lbounds(3)
      integer, intent(in), optional:: ubounds(3)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt3

    subroutine PutLineInt4( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:,:,:)
      integer, intent(in), optional:: lbounds(4)
      integer, intent(in), optional:: ubounds(4)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt4

    subroutine PutLineInt5( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:,:,:,:)
      integer, intent(in), optional:: lbounds(5)
      integer, intent(in), optional:: ubounds(5)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt5

    subroutine PutLineInt6( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(6)
      integer, intent(in), optional:: ubounds(6)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt6

    subroutine PutLineInt7( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      integer, intent(in):: array(:,:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(7)
      integer, intent(in), optional:: ubounds(7)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineInt7

    subroutine PutLineReal1( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:)
      integer, intent(in), optional:: lbounds(1)
      integer, intent(in), optional:: ubounds(1)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal1

    subroutine PutLineReal2( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:)
      integer, intent(in), optional:: lbounds(2)
      integer, intent(in), optional:: ubounds(2)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal2

    subroutine PutLineReal3( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:,:)
      integer, intent(in), optional:: lbounds(3)
      integer, intent(in), optional:: ubounds(3)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal3

    subroutine PutLineReal4( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:,:,:)
      integer, intent(in), optional:: lbounds(4)
      integer, intent(in), optional:: ubounds(4)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal4

    subroutine PutLineReal5( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:,:,:,:)
      integer, intent(in), optional:: lbounds(5)
      integer, intent(in), optional:: ubounds(5)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal5

    subroutine PutLineReal6( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(6)
      integer, intent(in), optional:: ubounds(6)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal6

    subroutine PutLineReal7( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real, intent(in):: array(:,:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(7)
      integer, intent(in), optional:: ubounds(7)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineReal7

    subroutine PutLineDouble1( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:)
      integer, intent(in), optional:: lbounds(1)
      integer, intent(in), optional:: ubounds(1)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble1

    subroutine PutLineDouble2( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:)
      integer, intent(in), optional:: lbounds(2)
      integer, intent(in), optional:: ubounds(2)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble2

    subroutine PutLineDouble3( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:,:)
      integer, intent(in), optional:: lbounds(3)
      integer, intent(in), optional:: ubounds(3)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble3

    subroutine PutLineDouble4( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:,:,:)
      integer, intent(in), optional:: lbounds(4)
      integer, intent(in), optional:: ubounds(4)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble4

    subroutine PutLineDouble5( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:,:,:,:)
      integer, intent(in), optional:: lbounds(5)
      integer, intent(in), optional:: ubounds(5)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble5

    subroutine PutLineDouble6( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(6)
      integer, intent(in), optional:: ubounds(6)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble6

    subroutine PutLineDouble7( array, lbounds, ubounds, unit, indent, sd  )
      use dc_types, only: DP
      real(DP), intent(in):: array(:,:,:,:,:,:,:)
      integer, intent(in), optional:: lbounds(7)
      integer, intent(in), optional:: ubounds(7)
      integer, intent(in), optional:: unit
      character(*), intent(in), optional:: indent
      logical, intent(in), optional:: sd
    end subroutine PutLineDouble7

  end interface

contains

  logical function strhead_cc(whole, head) result(result)
    !
    ! 譁�ｭ怜� head 縺ｨ譁�ｭ怜� whole 縺ｮ蜈磯�ｭ驛ｨ蛻� (head 縺ｨ蜷後§譁�ｭ怜�髟ｷ)
    ! 縺ｨ繧呈ｯ碑ｼ�＠縲∝酔縺倥ｂ縺ｮ縺ｪ繧峨� .true. 繧偵∫焚縺ｪ繧句�ｴ蜷医↓縺ｯ .false.
    ! 繧定ｿ斐＠縺ｾ縺吶� whole 縺ｮ譁�ｭ怜�髟ｷ縺� head 縺ｮ譁�ｭ怜�髟ｷ繧医ｊ繧ら洒縺��ｴ蜷医↓縺ｯ
    ! .false. 繧定ｿ斐＠縺ｾ縺吶�
    !
    character(len = *), intent(in):: whole
    character(len = *), intent(in):: head
  continue
    result = (len(whole) >= len(head))
    if (.not. result) return
    result = (whole(1:len(head)) == head)
  end function strhead_cc

  logical function StriEq_cc(string_a, string_b) result(result)
    !
    ! 螟ｧ譁�ｭ励�蟆乗枚蟄励ｒ辟｡隕悶＠縺ｦ譁�ｭ怜�縺ｮ豈碑ｼ�ｒ陦後＞縺ｾ縺吶�
    ! 譁�ｭ怜� string_a 縺ｨ譁�ｭ怜� string_b 繧呈ｯ碑ｼ�＠縲∝酔縺倥ｂ縺ｮ縺ｪ繧峨�
    ! .true. 繧偵∫焚縺ｪ繧句�ｴ蜷医↓縺ｯ .false. 繧定ｿ斐＠縺ｾ縺吶�
    !
    !--
    ! 窶ｻ 豕ｨ諢乗嶌縺� 窶ｻ
    !
    ! 繧ｳ繝ｳ繝代う繝ｩ縺ｫ繧医▲縺ｦ縺ｯ character(len = len(string_a)):: abuf
    ! 縺碁壹ｉ縺ｪ縺�◆繧�, 譁�ｭ玲焚繧� dc_types 縺ｧ謠蝉ｾ帙＆繧後ｋ遞ｮ蛻･蝙�
    ! 繝代Λ繝｡繧ｿ STRING 縺ｧ蛻ｶ髯�
    !++
    !
    character(len = *), intent(in):: string_a
    character(len = *), intent(in):: string_b
    character(len = STRING):: abuf
    character(len = STRING):: bbuf
    abuf = string_a
    bbuf = string_b
    call toUpper(abuf)
    call toUpper(bbuf)
    result = (abuf == bbuf)
  end function StriEq_cc

  logical function str_include_ac( &
    & carray, string, ignore_space, ignore_case ) result(result)
    !
    ! 譁�ｭ怜梛驟榊�蠑墓焚 *carray* 縺梧枚蟄怜梛蠑墓焚 *string* 縺ｨ遲峨＠縺�ｦ∫ｴ�繧呈戟縺､蝣ｴ蜷医↓
    ! .true. 繧定ｿ斐＠縺ｾ縺�.
    !
    ! 譁�ｭ怜�縺ｮ蜑榊ｾ後�遨ｺ逋ｽ縺ｯ辟｡隕悶＆繧後∪縺�.
    ! 繧ｪ繝励す繝ｧ繝翫Ν蠑墓焚 *ignore_space* 縺ｫ .false. 繧�
    ! 荳弱∴縺溷�ｴ蜷医↓縺ｯ譁�ｭ怜�蜈磯�ｭ縺ｮ遨ｺ逋ｽ繧堤┌隕悶＠縺ｾ縺帙ｓ.
    !
    ! 繧ｪ繝励す繝ｧ繝翫Ν蠑墓焚 *ignore_case* 縺ｫ .true. 繧剃ｸ弱∴縺溷�ｴ蜷医↓縺ｯ
    ! 螟ｧ譁�ｭ�, 蟆乗枚蟄励�驕輔＞繧堤┌隕悶＠縺ｦ豈碑ｼ�＠縺ｾ縺�.
    !
    ! If an character array argument *carray* has the same
    ! as character argument *string*, ".true." is returned.
    !
    ! And beginning and trailing spaces are ignored.
    ! If ".false." is given to an optional argument *ignore_space*,
    ! beginning spaces are not ignored.
    !
    ! If ".true." is given to an optional argument *ignore_case*,
    ! this function ignores case.
    !
    character(*), intent(in):: carray(:)
    character(*), intent(in):: string
    logical, intent(in), optional:: ignore_space
    logical, intent(in), optional:: ignore_case
    integer:: array_size, i
    logical:: ignore_space_work, ignore_case_work
  continue
    ignore_space_work = .true.
    if ( present(ignore_space) ) then
      if ( .not. ignore_space ) then
        ignore_space_work = .false.
      end if
    end if

    ignore_case_work = .false.
    if ( present(ignore_case) ) then
      if ( ignore_case ) then
        ignore_case_work = .true.
      end if
    end if

    array_size = size(carray)
    do i = 1, array_size
      if ( ignore_space_work ) then
        if ( ignore_case_work ) then
          result = &
            & StriEq_cc( trim( adjustl( carray(i) ) ), &
            &            trim( adjustl( string    ) ) )
        else
          result = &
            & ( trim( adjustl( carray(i) ) ) == trim( adjustl( string ) ) )
        end if

      else
        if ( ignore_case_work ) then
          result = &
            & StriEq_cc( trim( carray(i) ), trim( string ) )
        else
          result = ( trim(carray(i)) == trim(string) )
        end if
      end if
      if (result) return
    end do
  end function str_include_ac

  logical function str2bool(string) result(result)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧定ｫ也炊蝙九↓縺励※霑斐＠縺ｾ縺吶� string
    ! 縺檎ｩｺ縲� 縺ｾ縺溘� 0縲� 0.0縲� 0.0D0縲� 0.0d0縲� .false.縲� .FALSE.縲� f縲�
    ! F縲� false縲� FALSE 縺ｮ蝣ｴ蜷医↓縺ｯ <tt>.false.</tt> 縺瑚ｿ斐ｊ縺ｾ縺吶�
    ! 縺昴ｌ莉･螟悶�蝣ｴ蜷医↓縺ｯ <tt>.true.</tt> 縺瑚ｿ斐ｊ縺ｾ縺吶�
    !
    character(len = *), intent(in):: string
  continue
    select case(string)
    case ("", "0", "0.0", "0.0D0", "0.0d0", ".false.", ".FALSE.", &
            & "f", "F", "false", "FALSE")
      result = .false.
    case default
      result = .true.
    end select
  end function str2bool

  integer function atoi_scalar(string, default) result(result)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧偵∵紛謨ｰ蝙句､画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 繧ゅ＠繧� string 縺梧焚蛟､縺ｫ螟画鋤縺ｧ縺阪↑縺��ｴ蜷医‥efault 縺瑚ｿ斐ｊ縺ｾ縺吶�
    ! default 繧呈欠螳壹＠縺ｪ縺��ｴ蜷医� 0 縺瑚ｿ斐ｊ縺ｾ縺吶�
    !
    character(len = *), intent(in):: string
    integer, intent(in), optional:: default
    integer:: ios
  continue
    read(unit=string, fmt="(i80)", iostat=ios) result
    if (ios /= 0) then
      if (present(default)) then
        result = default
      else
        result = 0
      endif
    endif
  end function atoi_scalar

  real(DP) function atod_scalar(string) result(result)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧偵∝咲ｲｾ蠎ｦ螳滓焚蝙句､画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 繧ゅ＠繧� string 縺梧焚蛟､縺ｫ螟画鋤縺ｧ縺阪↑縺��ｴ蜷医�0.0 縺瑚ｿ斐ｊ縺ｾ縺吶�
    !
    use dc_types, only: STRING_LEN => STRING
    character(len = *), intent(in):: string
    integer:: ios
    character(len = STRING_LEN):: buffer
    integer:: ipoint, iexp
    intrinsic scan
  continue
    buffer = string
    ! 繧ゅ＠謨ｴ螳壽焚繧偵＞繧後※縺励∪縺｣縺溷�ｴ蜷医�蟆乗焚轤ｹ繧帝刋蜉�
    if (index(buffer, '.') == 0) then
      iexp = scan(buffer, "eEdD")
      if (iexp /= 0) then
        buffer(iexp+1: len(buffer)) = buffer(iexp: len(buffer)-1)
        ipoint = iexp
      else
        ipoint = len_trim(buffer) + 1
      endif
      buffer(ipoint: ipoint) = '.'
    endif
    read(unit=buffer, fmt="(g80.10)", iostat=ios) result
    if (ios /= 0) result = 0.0
  end function atod_scalar

  subroutine str2ip(int_ptr, string)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧偵き繝ｳ繝槭�,縲阪〒蛹ｺ蛻�ｊ縲�
    ! 謨ｴ謨ｰ蝙矩�蛻励�繧､繝ｳ繧ｿ int_ptr(:) 縺ｫ縺励※霑斐＠縺ｾ縺吶� int_ptr(:)
    ! 縺ｮ驟榊�繧ｵ繧､繧ｺ縺ｯ string 縺ｮ蜀�ｮｹ縺ｫ蠢懊§縺ｦ閾ｪ蜍慕噪縺ｫ豎ｺ縺ｾ繧翫∪縺吶�
    !
    ! 縺溘□縺励（nt_ptr(:) 縺ｯ蠢�★遨ｺ迥ｶ諷九∪縺溘�荳榊ｮ夂憾諷九〒荳弱∴縺ｦ縺上□縺輔＞縲�
    ! 譌｢縺ｫ蜑ｲ繧贋ｻ倥￠繧峨ｌ縺ｦ縺�ｋ蝣ｴ蜷医√Γ繝｢繝ｪ繝ｪ繝ｼ繧ｯ繧定ｵｷ縺薙＠縺ｾ縺吶�
    !
    integer, pointer:: int_ptr(:) !(out)
    character(len = *), intent(in):: string
    integer:: i, j, idx, nvalues
  continue
    nvalues = 1
    i = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) exit
      i = i + idx - 1 + 1
      nvalues = nvalues + 1
    enddo
    allocate(int_ptr(nvalues))
    i = 1
    j = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) then
        int_ptr(j) = stoi(string(i: ))
        exit
      endif
      int_ptr(j) = stod(string(i: i+idx-2))
      i = i + idx - 1 + 1
      j = j + 1
    enddo
  end subroutine str2ip

  subroutine str2rp(real_ptr, string)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧偵き繝ｳ繝槭�,縲阪〒蛹ｺ蛻�ｊ縲�
    ! 蜊倡ｲｾ蠎ｦ螳滓焚蝙矩�蛻励�繧､繝ｳ繧ｿ real_ptr(:) 縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! real_ptr(:) 縺ｮ驟榊�繧ｵ繧､繧ｺ縺ｯ string 縺ｮ蜀�ｮｹ縺ｫ蠢懊§縺ｦ閾ｪ蜍慕噪縺ｫ豎ｺ縺ｾ繧翫∪縺吶�
    !
    ! 縺溘□縺励〉eal_ptr(:) 縺ｯ蠢�★遨ｺ迥ｶ諷九∪縺溘�荳榊ｮ夂憾諷九〒荳弱∴縺ｦ縺上□縺輔＞縲�
    ! 譌｢縺ｫ蜑ｲ繧贋ｻ倥￠繧峨ｌ縺ｦ縺�ｋ蝣ｴ蜷医√Γ繝｢繝ｪ繝ｪ繝ｼ繧ｯ繧定ｵｷ縺薙＠縺ｾ縺吶�
    !
    real, pointer:: real_ptr(:) !(out)
    character(len = *), intent(in):: string
    integer:: i, j, idx, nvalues
  continue
    nvalues = 1
    i = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) exit
      i = i + idx - 1 + 1
      nvalues = nvalues + 1
    enddo
    allocate(real_ptr(nvalues))
    i = 1
    j = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) then
        real_ptr(j) = stod(string(i: ))
        exit
      endif
      real_ptr(j) = stod(string(i: i+idx-2))
      i = i + idx - 1 + 1
      j = j + 1
    enddo
  end subroutine str2rp

  subroutine str2dp(real_ptr, string)
    !
    ! string 縺ｧ荳弱∴繧峨ｌ繧区枚蟄怜梛螟画焚繧偵き繝ｳ繝槭�,縲阪〒蛹ｺ蛻�ｊ縲�
    ! 蛟咲ｲｾ蠎ｦ螳滓焚蝙矩�蛻励�繧､繝ｳ繧ｿ real_ptr(:) 縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! real_ptr(:) 縺ｮ驟榊�繧ｵ繧､繧ｺ縺ｯ string 縺ｮ蜀�ｮｹ縺ｫ蠢懊§縺ｦ閾ｪ蜍慕噪縺ｫ豎ｺ縺ｾ繧翫∪縺吶�
    !
    ! 縺溘□縺励〉eal_ptr(:) 縺ｯ蠢�★遨ｺ迥ｶ諷九∪縺溘�荳榊ｮ夂憾諷九〒荳弱∴縺ｦ縺上□縺輔＞縲�
    ! 譌｢縺ｫ蜑ｲ繧贋ｻ倥￠繧峨ｌ縺ｦ縺�ｋ蝣ｴ蜷医√Γ繝｢繝ｪ繝ｪ繝ｼ繧ｯ繧定ｵｷ縺薙＠縺ｾ縺吶�
    !
    real(DP), pointer:: real_ptr(:) !(out)
    character(len = *), intent(in):: string
    integer:: i, j, idx, nvalues
  continue
    nvalues = 1
    i = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) exit
      i = i + idx - 1 + 1
      nvalues = nvalues + 1
    enddo
    allocate(real_ptr(nvalues))
    i = 1
    j = 1
    do
      idx = index(string(i: ), ',')
      if (idx == 0) then
        real_ptr(j) = stod(string(i: ))
        exit
      endif
      real_ptr(j) = stod(string(i: i+idx-2))
      i = i + idx - 1 + 1
      j = j + 1
    enddo
  end subroutine str2dp

  !== 謨ｰ蛟､蝙九∬ｫ也炊蝙九°繧画枚蟄怜梛縺ｸ縺ｮ螟画鋤
  !
  ! 邱冗ｧｰ蜷咲ｧｰ toChar 縺ｨ縺励※蜻ｼ縺ｳ蜃ｺ縺輔ｌ繧矩未謨ｰ鄒､
  !
  character(TOKEN) function itoa_scalar(i) result(result)
    !
    ! 謨ｴ謨ｰ蝙句､画焚 i 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    integer, intent(in):: i
    character(len = 32):: buffer
  continue
    write(unit=buffer, fmt="(i20)") i
    result = adjustl(buffer)
  end function itoa_scalar

  character(STRING) function itoa_array(ibuf) result(result)
    !
    ! 謨ｴ謨ｰ蝙矩�蛻怜､画焚 ibuf(:) 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    integer, intent(in):: ibuf(:)
    integer:: i
  continue
    if (size(ibuf) <= 0) then
      result = ""
      return
    endif
    result = toChar(ibuf(1))
    do, i = 2, size(ibuf)
      result = trim(result) // ", " // trim(toChar(ibuf(i)))
    enddo
  end function itoa_array

  character(TOKEN) function rtoa_scalar(x) result(result)
    !
    ! 蜊倡ｲｾ蠎ｦ螳滓焚蝙句､画焚 x 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    real, intent(in):: x
    character(len = 16):: buffer, expbuf
    integer:: ptr, eptr
  continue
    write(unit=buffer, fmt="(g16.8)") x
    eptr = scan(buffer, "eE", back=.true.)
    expbuf = ''
    if (eptr > 1) then
      expbuf = buffer(eptr: )
      buffer(eptr: ) = " "
    end if

    ptr = verify(buffer, " 0", back=.true.)
    if (ptr > 0) buffer(ptr+1: ) = " "

    if (eptr > 1) then
      buffer = buffer(1:len_trim(buffer)) // expbuf
    end if
    result = adjustl(buffer)
  end function rtoa_scalar

  character(STRING) function rtoa_array(rbuf) result(result)
    !
    ! 蜊倡ｲｾ蠎ｦ螳滓焚蝙矩�蛻� rbuf(:)縲√〒荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    real, intent(in):: rbuf(:)
    integer:: i
  continue
    if (size(rbuf) <= 0) then
      result = ""
      return
    endif
    result = toChar(rbuf(1))
    do, i = 2, size(rbuf)
      result = trim(result) // ", " // trim(toChar(rbuf(i)))
    enddo
  end function rtoa_array

  character(TOKEN) function dtoa_scalar(d) result(result)
    !
    ! 蛟咲ｲｾ蠎ｦ螳滓焚蝙句､画焚 d 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    real(DP), intent(in):: d
    character(len = 32):: buffer, expbuf
    integer:: ptr, eptr
  continue
    write(unit=buffer, fmt="(g32.24)") d
    eptr = scan(buffer, "eE", back=.true.)
    expbuf = ''
    if (eptr > 1) then
      expbuf = buffer(eptr: )
      buffer(eptr: ) = " "
    end if

    ptr = verify(buffer, " 0", back=.true.)
    if (ptr > 0) buffer(ptr+1: ) = " "

    if (eptr > 1) then
      buffer = buffer(1:len_trim(buffer)) // expbuf
    end if
    result = adjustl(buffer)
  end function dtoa_scalar

  character(STRING) function dtoa_array(dbuf) result(result)
    !
    ! 蛟咲ｲｾ蠎ｦ螳滓焚蝙矩�蛻� dbuf(:) 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    real(DP), intent(in):: dbuf(:)
    integer:: i
  continue
    if (size(dbuf) <= 0) then
      result = ""
      return
    endif
    result = toChar(dbuf(1))
    do, i = 2, size(dbuf)
      result = trim(result) // ", " // trim(toChar(dbuf(i)))
    enddo
  end function dtoa_array

  character(TOKEN) function ltoa_scalar(l) result(result)
    !
    ! 隲也炊蝙句､画焚 l 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    logical, intent(in):: l
  continue
    if (l) then
      result = ".true."
    else
      result = ".false."
    end if
  end function ltoa_scalar

  character(STRING) function ltoa_array(lbuf) result(result)
    !
    ! 隲也炊蝙矩�蛻� lbuf(:) 縺ｧ荳弱∴繧峨ｌ繧区焚蛟､繧呈枚蟄怜梛螟画焚縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! 驟榊�縺御ｸ弱∴繧峨ｌ繧句�ｴ蜷医∝推隕∫ｴ�繧偵き繝ｳ繝槭→遨ｺ逋ｽ縲�<tt>, </tt>縲�
    ! 縺ｧ蛹ｺ蛻�▲縺ｦ霑斐＠縺ｾ縺吶�
    !
    logical, intent(in):: lbuf(:)
    integer:: i
  continue
    if (size(lbuf) <= 0) then
      result = ""
      return
    endif
    result = toChar(lbuf(1))
    do, i = 2, size(lbuf)
      result = trim(result) // ", " // trim(toChar(lbuf(i)))
    enddo
  end function ltoa_array

  !-------------------------------------------------------------------
  !  譁�ｭ鈴�蛻励�騾｣邨�
  !-------------------------------------------------------------------

  character(STRING) function JoinChar(carray, expr) result(result)
    !
    ! 譁�ｭ怜梛驟榊� carray 縺ｫ荳弱∴縺溯､�焚縺ｮ譁�ｭ怜�繧偵き繝ｳ繝槭→遨ｺ逋ｽ
    ! 縲�<tt>, </tt>縲� 縺ｧ蛹ｺ蛻�▲縺�1縺､縺ｮ譁�ｭ怜�縺ｫ縺励※霑斐＠縺ｾ縺吶�
    ! expr 縺ｫ譁�ｭ怜�繧剃ｸ弱∴繧九→縲√◎縺ｮ譁�ｭ怜�繧貞玄蛻�ｊ譁�ｭ励→縺励※逕ｨ縺�∪縺吶�
    !
    implicit none
    character(*)     , intent(in)           :: carray(:)
    character(*)     , intent(in), optional :: expr

    character(2)     ,parameter :: default = ', '
    character(STRING)           :: delimiter
    integer                     :: dellen, i
  continue
    if ( present(expr) ) then
      delimiter = expr
      dellen = len(expr)
    else
      delimiter = default
      dellen = len(default)
    endif
    if (size(carray) <= 0) then
      result = ""
      return
    endif
    result = trim(carray(1))
    do, i = 2, size(carray)
      result = trim(result) // delimiter(1:dellen) // trim(carray(i))
    enddo
  end function JoinChar

  subroutine concat_tail(carray, str, result)
    !
    ! 譁�ｭ怜梛驟榊� *carray* 縺ｮ蜷��蛻��譛ｫ蟆ｾ縺ｫ *str* 繧定ｿｽ蜉�縺励※
    ! *result* 縺ｫ霑斐＠縺ｾ縺吶�*carray* 縺ｮ蜷��蛻��譛ｫ蟆ｾ縺ｮ遨ｺ逋ｽ縺ｯ辟｡隕悶＆繧後∪縺吶�
    !
    ! result(:) 縺ｮ驟榊�繧ｵ繧､繧ｺ縺ｯ carray 縺ｮ繧ｵ繧､繧ｺ縺ｫ蠢懊§縺ｦ閾ｪ蜍慕噪縺ｫ豎ｺ縺ｾ繧翫∪縺吶�
    ! 縺溘□縺励〉esult(:) 縺ｯ蠢�★遨ｺ迥ｶ諷九∪縺溘�荳榊ｮ夂憾諷九〒荳弱∴縺ｦ縺上□縺輔＞縲�
    ! 譌｢縺ｫ蜑ｲ繧贋ｻ倥￠繧峨ｌ縺ｦ縺�ｋ蝣ｴ蜷医√Γ繝｢繝ｪ繝ｪ繝ｼ繧ｯ繧定ｵｷ縺薙＠縺ｾ縺吶�
    !
    implicit none
    character(*), intent(in)  :: carray(:)
    character(*), intent(in)  :: str
    character(STRING), pointer:: result(:) ! (out)
    integer                     :: i, size_carray
  continue
    size_carray = size(carray)
    allocate(result(size_carray))

    do i = 1, size_carray
      result(i) = trim(carray(i)) // str
    end do

  end subroutine concat_tail

  function Str_to_Array1(c1) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1
    character(STRING) :: result(1)

  continue
    result(1) = c1
  end function Str_to_Array1

  function Str_to_Array2(c1, c2) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2
    character(STRING) :: result(2)

  continue
    result(1) = c1
    result(2) = c2
  end function Str_to_Array2

  function Str_to_Array3(c1, c2, c3) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3
    character(STRING) :: result(3)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
  end function Str_to_Array3

  function Str_to_Array4(c1, c2, c3, c4) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4
    character(STRING) :: result(4)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
  end function Str_to_Array4

  function Str_to_Array5(c1, c2, c3, c4, c5) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5
    character(STRING) :: result(5)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
  end function Str_to_Array5

  function Str_to_Array6(c1, c2, c3, c4, c5, c6) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6
    character(STRING) :: result(6)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
  end function Str_to_Array6

  function Str_to_Array7(c1, c2, c3, c4, c5, c6, c7) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7
    character(STRING) :: result(7)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
  end function Str_to_Array7

  function Str_to_Array8(c1, c2, c3, c4, c5, c6, c7, c8) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7, c8
    character(STRING) :: result(8)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
    result(8) = c8
  end function Str_to_Array8

  function Str_to_Array9(c1, c2, c3, c4, c5, c6, c7, c8, c9) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7, c8, c9
    character(STRING) :: result(9)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
    result(8) = c8
    result(9) = c9
  end function Str_to_Array9

  function Str_to_Array10(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7, c8, c9, c10
    character(STRING) :: result(10)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
    result(8) = c8
    result(9) = c9
    result(10) = c10
  end function Str_to_Array10

  function Str_to_Array11(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11
    character(STRING) :: result(11)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
    result(8) = c8
    result(9) = c9
    result(10) = c10
    result(11) = c11
  end function Str_to_Array11

  function Str_to_Array12(c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12) result(result)
    !
    ! 逡ｰ縺ｪ繧矩聞縺輔�隍�焚縺ｮ譁�ｭ怜梛螟画焚繧� 1 縺､縺ｮ譁�ｭ怜梛驟榊�縺ｫ螟画鋤縺励∪縺吶�
    !
    ! 1 縺九ｉ 12 蛟九∪縺ｧ縺ｮ蠑墓焚繧剃ｸ弱∴繧九％縺ｨ縺悟庄閭ｽ縺ｧ縺吶�
    !
    character(*), intent(in) :: c1, c2, c3, c4, c5, c6, c7, c8, c9, c10, c11, c12
    character(STRING) :: result(12)

  continue
    result(1) = c1
    result(2) = c2
    result(3) = c3
    result(4) = c4
    result(5) = c5
    result(6) = c6
    result(7) = c7
    result(8) = c8
    result(9) = c9
    result(10) = c10
    result(11) = c11
    result(12) = c12
  end function Str_to_Array12

  !-------------------------------------------------------------------
  !  譁�ｭ怜�縺ｮ蛻�ｧ｣
  !-------------------------------------------------------------------

  subroutine Split_CC(str, carray, sep, limit)
    !
    ! *str* 縺ｧ荳弱∴繧峨ｌ縺滓枚蟄怜�繧� 譁�ｭ怜� *sep* 縺ｧ蛻�ｧ｣縺�,
    ! 繝昴う繝ｳ繧ｿ驟榊� *carray* 縺ｫ霑斐＠縺ｾ縺�.
    ! *carray* 縺ｯ蠢�★遨ｺ迥ｶ諷九↓縺励※荳弱∴縺ｦ縺上□縺輔＞. 蜑ｲ繧贋ｻ倥￠迥ｶ諷九�
    ! 蝣ｴ蜷医↓縺ｯ繧ｨ繝ｩ繝ｼ繧定ｿ斐＠縺ｾ縺�.
    !
    ! *limit* 縺ｫ豁｣縺ｮ謨ｰ繧剃ｸ弱∴縺溷�ｴ蜷�, 譛螟ｧ *limit* 蛟九�繝輔ぅ繝ｼ繝ｫ繝峨↓蛻�牡
    ! 縺励∪縺�.  雋�縺ｮ謨ｰ繧� 0 縺ｮ蝣ｴ蜷医�逵∫払縺励◆蝣ｴ蜷医→蜷後§縺ｫ縺ｪ繧翫∪縺�.  *str*
    ! 縺ｮ譛ｫ蟆ｾ縺ｮ遨ｺ逋ｽ縺ｯ髯､蜴ｻ縺輔ｌ縺ｾ縺�.  *sep* 縺ｫ遨ｺ譁�ｭ励ｒ莉｣蜈･縺吶ｋ蝣ｴ蜷�, 遨ｺ逋ｽ
    ! 譁�ｭ励〒蛻�牡縺輔ｌ縺ｾ縺�.
    !
    use dc_types, only: STRING
    implicit none
    character(*), intent(in):: str
    character(*), pointer:: carray(:) !(out)
    character(*), intent(in):: sep
    integer, intent(in), optional:: limit
    integer :: num, cur, i, limitnum
    character(STRING) :: substr
    logical :: end_flag
  continue
    if (present(limit)) then
      if (limit > 0) then
        limitnum = limit
      else
        limitnum = 0
      end if
    else
      limitnum = 0
    end if

    if (len(trim(sep)) == 0) then
      num = 1
      substr = str
      ! 驥崎､�＠縺ｦ辟｡鬧�□縺� carray 繧� allocate 縺吶ｋ縺溘ａ, 菴募�蜑ｲ縺吶ｋ縺�
      ! 隱ｿ縺ｹ, num 縺ｫ譬ｼ邏阪☆繧�.
      do
        cur = index(trim(substr), ' ')
        if (cur == 0) exit
        num = num + 1
        substr = adjustl(substr(cur + len(sep) :len(substr)))
      end do

      if (limitnum /= 0 .and. num > limitnum) num = limitnum
      allocate(carray(num))

      substr = str
      end_flag = .false.
      do i = 1, num
        cur = index(trim(substr), ' ')
        if (cur == 0 .or. i == num) end_flag = .true.
        if (end_flag) then
          carray(i) = substr
          exit
        else
          carray(i) = substr(1:cur - 1)
        end if
        substr = adjustl(substr(cur + len(sep) :len(substr)))
      end do

    else
      num = 1
      substr = str
      ! 驥崎､�＠縺ｦ辟｡鬧�□縺� carray 繧� allocate 縺吶ｋ縺溘ａ, 菴募�蜑ｲ縺吶ｋ縺�
      ! 隱ｿ縺ｹ, num 縺ｫ譬ｼ邏阪☆繧�.
      do
        cur = index(substr, trim(sep))
        if (cur == 0) exit
        num = num + 1
        substr = substr(cur + len(sep) :len(substr))
      end do

      if (limitnum /= 0 .and. num > limitnum) num = limitnum
      allocate(carray(num))

      substr = str
      end_flag = .false.
      do i = 1, num
        cur = index(substr, trim(sep))
        if (cur == 0 .or. i == num) end_flag = .true.
        if (end_flag) then
          carray(i) = substr
          exit
        else
          carray(i) = substr(1:cur - 1)
        end if
        substr = substr(cur + len(sep) :len(substr))
      end do
    end if

    return

  end subroutine Split_CC

  !-------------------------------------------------------------------
  !  譁�ｭ怜�縺ｮ隗｣譫�
  !-------------------------------------------------------------------

  integer function Index_Ofs(string, start, substr) result(result)
    !
    ! 譁�ｭ怜� string 縺ｮ start 譁�ｭ礼岼莉･髯阪�譁�ｭ怜�縺ｮ荳ｭ縺ｫ substr
    ! 縺ｮ譁�ｭ怜�縺悟性縺ｾ繧後※縺�ｋ譎ゅ√◎縺ｮ髢句ｧ区枚蟄嶺ｽ咲ｽｮ繧定ｿ斐＠縺ｾ縺吶�
    ! 蜷ｫ縺ｾ繧後↑縺��ｴ蜷医� 0 繧定ｿ斐＠縺ｾ縺吶�
    ! 霑斐＆繧後ｋ髢句ｧ区枚蟄嶺ｽ咲ｽｮ縺ｯ譁�ｭ怜� string 縺ｮ蜈磯�ｭ縺九ｉ謨ｰ縺医∪縺吶�
    !
    character(len = *), intent(in):: string
    integer, intent(in):: start
    character(len = *), intent(in):: substr
    intrinsic index
    if (start < 1) then
      result = 0
      return
    endif
    result = index(string(start: ), substr)
    if (result == 0) return
    result = start + result - 1
  end function Index_Ofs

  recursive function Replace( &
    & string, from, to, recursive, start_pos ) result(result)
    !
    ! 譁�ｭ怜� *string* 縺ｫ譁�ｭ怜� *from* 縺悟性縺ｾ繧後ｋ蝣ｴ蜷�, 縺昴�驛ｨ蛻�ｒ譁�ｭ怜� *to*
    ! 縺ｫ鄂ｮ謠帙＠縺ｦ霑斐＠縺ｾ縺�. 譁�ｭ怜� *from* 縺悟性縺ｾ繧後↑縺��ｴ蜷医� *string*
    ! 繧偵◎縺ｮ縺ｾ縺ｾ霑斐＠縺ｾ縺�. *from* 縺瑚､�焚蜷ｫ縺ｾ繧後ｋ蝣ｴ蜷�, 蜈磯�ｭ縺ｮ *from*
    ! 縺ｮ縺ｿ縺檎ｽｮ謠帙＆繧後∪縺�.
    !
    ! 蜈ｨ縺ｦ縺ｮ *from* 繧� *to* 縺ｸ螟画鋤縺励◆縺��ｴ蜷医↓縺ｯ,
    ! 繧ｪ繝励す繝ｧ繝翫Ν蠑墓焚 *recursive* 縺ｫ .true. 繧剃ｸ弱∴縺ｦ縺上□縺輔＞.
    !
    ! 繝�ヵ繧ｩ繝ｫ繝医〒縺ｯ, 譁�ｭ怜�縺ｮ譛蛻昴°繧画､懃ｴ｢繧定｡後＞縺ｾ縺�.
    ! 繧ｪ繝励す繝ｧ繝翫Ν蠑墓焚 *start_pos* 繧剃ｸ弱∴繧句�ｴ蜷�,
    ! *start_pos* 譁�ｭ礼岼縺九ｉ讀懃ｴ｢繧定｡後＞縺ｾ縺�.
    !
    ! If a string *from* is included in *string*, the string is
    ! replace to *to*, and the replaced string is returned.
    ! If a string *from* is not included, *string* is returned
    ! without change.
    ! When multiple *from* are included, only first *from* is replaced.
    !
    ! In order to replace all *from* to *to*, give ".true." to
    ! optional argument *recursive*.
    !
    ! By default, the string is searched from the top.
    ! If optional argument *start_pos* is given,
    ! the search is started from *start_pos*.
    !
    use dc_types, only: STRLEN => STRING
    implicit none
    character(STRLEN):: result
    character(*), intent(in):: string, from, to
    logical, intent(in), optional:: recursive
    integer, intent(in), optional:: start_pos
    integer:: sp
    integer:: i, isa, isb, iea, ieb
    integer:: ir
  continue
    if ( present(start_pos) ) then
      sp = start_pos
    else
      sp = 1
    end if
    if ( sp < 1 ) then
      sp = 1
    end if

    result = string
    i = index(result(sp:), from)
    if (i == 0) return
    i = i + sp - 1
    isa = i + len(from)
    isb = i + len(to)
    if (len(to) < len(from)) then
      iea = len(result)
      ieb = len(result) + len(to) - len(from)
    else
      iea = len(result) + len(from) - len(to)
      ieb = len(result)
    endif
    if (len(to) /= len(from)) result(isb:ieb) = result(isa:iea)
    result(i:i+len(to)-1) = to

    !-----------------------------------
    !  蜀榊ｸｰ逧��逅�
    !  Recursive process
    ir = index(result(i+len(to):), from)
    if ( len_trim(from) == 0 ) then
      ir = index(trim(result(i+len(to):)), from)
    end if
    if (ir /= 0) then
      if ( present(recursive) ) then
        if ( recursive ) then
          result = Replace( string = result, &
            &               from = from, to = to, &
            &               recursive = recursive, &
            &               start_pos = i+len(to) )
        end if
      end if
    end if

  end function Replace

  !-------------------------------------------------------------------
  !  螟ｧ譁�ｭ励�蟆乗枚蟄励ｒ辟｡隕悶＠縺溷�逅�
  !-------------------------------------------------------------------

  subroutine cupper(ch)
    !
    ! 譁�ｭ怜� ch 縺ｫ闍ｱ蟄励′蜷ｫ縺ｾ繧後ｋ蝣ｴ蜷医√◎縺ｮ闍ｱ蟄励ｒ螟ｧ譁�ｭ励↓螟画鋤縺励※ ch
    ! 縺ｫ霑斐＠縺ｾ縺吶� 闍ｱ蟄励〒縺ｪ縺�枚蟄励ｄ譌｢縺ｫ螟ｧ譁�ｭ励↓縺ｪ縺｣縺ｦ縺�ｋ譁�ｭ励�
    ! 縺昴�縺ｾ縺ｾ霑斐＠縺ｾ縺吶�
    !
    character(len = *), intent(inout):: ch
    integer:: i, lch, idx
  continue
    lch = len(ch)
    do, i = 1, lch
      idx = ichar(ch(i:i))
      if (97 <= idx .and. idx <= 122) then
        ch(i:i)=char(idx - 32)
      end if
    end do
  end subroutine cupper

  subroutine clower(ch)
    !
    ! 譁�ｭ怜� ch 縺ｫ闍ｱ蟄励′蜷ｫ縺ｾ繧後ｋ蝣ｴ蜷医√◎縺ｮ闍ｱ蟄励ｒ蟆乗枚蟄励↓螟画鋤縺励※ ch
    ! 縺ｫ霑斐＠縺ｾ縺吶� 闍ｱ蟄励〒縺ｪ縺�枚蟄励ｄ譌｢縺ｫ蟆乗枚蟄励↓縺ｪ縺｣縺ｦ縺�ｋ譁�ｭ励�
    ! 縺昴�縺ｾ縺ｾ霑斐＠縺ｾ縺吶�
    !
    character(len = *), intent(inout):: ch
    integer:: i, lch, idx
  continue
    lch = len(ch)
    do, i = 1, lch
      idx = ichar(ch(i:i))
      if (65 <= idx .and. idx <= 90) then
        ch(i:i)=char(idx + 32)
      end if
    end do
  end subroutine clower

  character(STRING) function UChar(ch) result(result)
    !
    ! 譁�ｭ怜� ch 縺ｫ闍ｱ蟄励′蜷ｫ縺ｾ繧後ｋ蝣ｴ蜷医√◎縺ｮ闍ｱ蟄励ｒ螟ｧ譁�ｭ励↓螟画鋤縺励※霑斐＠縺ｾ縺吶�
    ! 闍ｱ蟄励〒縺ｪ縺�枚蟄励ｄ譌｢縺ｫ螟ｧ譁�ｭ励↓縺ｪ縺｣縺ｦ縺�ｋ譁�ｭ励�縺昴�縺ｾ縺ｾ霑斐＠縺ｾ縺吶�
    !
    character(len = *), intent(in):: ch
  continue
    result = ch
    call toUpper(result)
  end function UChar

  character(STRING) function LChar(ch) result(result)
    !
    ! 譁�ｭ怜� ch 縺ｫ闍ｱ蟄励′蜷ｫ縺ｾ繧後ｋ蝣ｴ蜷医√◎縺ｮ闍ｱ蟄励ｒ蟆乗枚蟄励↓螟画鋤縺励※霑斐＠縺ｾ縺吶�
    ! 闍ｱ蟄励〒縺ｪ縺�枚蟄励ｄ譌｢縺ｫ蟆乗枚蟄励↓縺ｪ縺｣縺ｦ縺�ｋ譁�ｭ励�縺昴�縺ｾ縺ｾ霑斐＠縺ｾ縺吶�
    !
    character(len = *), intent(in):: ch
  continue
    result = ch
    call toLower(result)
  end function LChar

  character(STRING) function RoundNum(num) result(result)
    !
    ! '0.30000001' 繧� '12.999998' 縺ｪ縺ｩ縺ｮ荳ｸ繧∬ｪ､蟾ｮ縺ｫ繧医▲縺ｦ遶ｯ謨ｰ縺梧ｮ九▲縺ｦ
    ! 縺励∪縺｣縺ｦ縺�ｋ謨ｰ蛟､陦ｨ險倥ｒ '0.3' 繧� '13.' 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢縺励※霑斐＠縺ｾ縺�.
    !
    character(*), intent(in):: num
    character(STRING):: nrv, enrv
    integer:: i, moving_up, nrvi, dig, zero_stream
  continue
    !
    ! 螳滓焚縺ｧ縺ｪ縺�ｂ縺ｮ縺ｫ縺､縺�※縺ｯ縺昴�縺ｾ縺ｾ霑斐☆.
    !
    if ( scan('.', trim(num) ) == 0  ) then
      result = num
      return
    end if
    nrv = num

    !
    ! 謖�焚驛ｨ繧帝∩縺代※縺翫￥.
    !
    enrv = ''
    i = scan(nrv, "eE", back=.true.)
    if ( i > 1  ) then
      enrv = nrv(i:)
      nrv(i:) = " "
    elseif ( i == 1 ) then
      result = nrv
      return
    end if

    !
    ! 0.30000001 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 1 縺ｮ繧医≧縺ｪ, 繧ｴ繝溘�譯√�謨ｰ蛟､繧呈祉髯､縺�,
    ! 0.3000000 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
      do while ( index('567890.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
        if ( len_trim(nrv) < 2 ) exit
        nrv = nrv(1:len_trim(nrv)-1)
      end do
    end if

    !
    ! 0.30000001986 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 1 莉･髯阪�繧ｴ繝溘�譯√�謨ｰ蛟､繧呈祉髯､縺�,
    ! 0.3000000 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
      dig = index( trim( nrv ), '.') + 1
      zero_stream = 0
      do while ( dig < len_trim( nrv ) )
        if ( nrv(dig:dig) == "0" ) then
          zero_stream = zero_stream + 1
        else
          zero_stream = 0
        end if
        if ( zero_stream > 7 ) then
          nrv(dig:len_trim(nrv)) = '0'
          exit
        end if
        dig = dig + 1
      end do
    end if

    !
    ! 0.3000000 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 0 繧呈祉髯､縺�,
    ! 0.3 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    if ( index( trim( nrv ), '.') /= 0 ) then
      do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
        if ( len_trim(nrv) < 2 ) exit
        nrv = nrv(1:len_trim(nrv)-1)
      end do
    end if

    !
    ! 0.89999998 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 8 縺ｮ繧医≧縺ｪ, 繧ｴ繝溘�譯√�謨ｰ蛟､繧呈祉髯､縺�,
    ! 0.8999999 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    moving_up = 0
    if ( index( trim( nrv ), '.') - len_trim( nrv ) < -7 ) then
      do while ( index('12345690.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
        if ( len_trim(nrv) < 2 ) exit
        nrv = nrv(1:len_trim(nrv)-1)
      end do
      moving_up = 1
    end if

    !
    ! 0.8999999 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 9 繧呈祉髯､縺�, 郢ｰ繧贋ｸ翫￡縺ｦ
    ! 0.9 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    if ( moving_up > 0 ) then
      do while ( index('012345678.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
        if ( len_trim(nrv) < 2 ) exit
        nrv = nrv(1:len_trim(nrv)-1)
      end do
    end if

    i = len_trim(nrv)
    do while ( moving_up > 0 .and. i > 0 )
      if ( index('.', nrv(i:i)) /= 0 ) then
        i = i - 1
        cycle
      end if
      nrvi = StoI( nrv(i:i) ) + moving_up

      if ( nrvi < 10 ) then
        nrv(i:i) = trim( toChar( nrvi ) )
        exit
      else
        nrv(i:i) = '0'
        if ( i < 2 ) then
          nrv = '10'
          exit
        else
          i = i - 1
          cycle
        end if
      end if
      if ( len_trim(nrv) < 2 ) exit
      nrv = nrv(1:len_trim(nrv)-1)
    end do

    !
    ! 0.3000000 縺ｪ縺ｩ縺ｮ譛ｫ蟆ｾ縺ｮ 0 繧呈祉髯､縺�,
    ! 0.3 縺ｪ縺ｩ縺ｫ謨ｴ蠖｢.
    !
    if ( index( trim( nrv ), '.') /= 0 ) then
      do while ( index('123456789.', nrv(len_trim(nrv):len_trim(nrv)) ) == 0 )
        if ( len_trim(nrv) < 2 ) exit
        nrv = nrv(1:len_trim(nrv)-1)
      end do
    end if

    !
    ! 謖�焚驛ｨ繧貞ｾｩ蟶ｰ縺吶ｋ
    !
    if ( len_trim(enrv) > 0 ) then
      nrv = trim(nrv) // enrv
    end if

    result = nrv
  end function RoundNum

end module

!--
! vi:set readonly sw=4 ts=8:
!
!Local Variables:
!mode: f90
!buffer-read-only: t
!End:
!
!++