dc_scaledsec.f90

Go to the documentation of this file.

! -*- mode: f90; coding: utf-8 -*-
!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
 
module dc_scaledsec
  !
  use dc_types, only: dp
  implicit none
  private
 
  public:: dc_scaled_sec
  public:: assignment(=), dcscaledsecputline
  public:: operator(==), operator(>), operator(<), operator(>=), operator(<=)
  public:: operator(+), operator(-), operator(*), operator(/), mod, modulo
  public:: abs, int, sign, floor, ceiling
 
!!$  integer, parameter:: imin = -1  ! 最小値の指数 = imin*6
!!$  integer, parameter:: imax =  4  ! 最大値の指数 = imax*6
!!$  real(DP), parameter:: scale_factor = 1.0e+6_DP
!!$  integer, parameter:: scale_factor_int = 1000000
  integer, parameter:: imin = -2  ! 最小値の指数 = imin*3
  integer, parameter:: imax =  8  ! 最大値の指数 = imax*3
  real(DP), parameter:: scale_factor = 1.0e+3_dp
  real(DP), parameter:: scale_factor_xx (-(imax+1):imax+1) = &
    & (/ 1.0e-27_DP, &
    &    1.0e-24_DP, 1.0e-21_DP, 1.0e-18_DP, 1.0e-15_DP, &
    &    1.0e-12_DP, 1.0e-9_DP,  1.0e-6_DP,  1.0e-3_DP,  &
    &    1.0_DP, &
    &    1.0e+3_DP,  1.0e+6_DP,  1.0e+9_DP,  1.0e+12_DP, &
    &    1.0e+15_DP, 1.0e+18_DP, 1.0e+21_DP, 1.0e+24_DP, &
    &    1.0e+27_DP /)
 
  integer, parameter:: scale_factor_int = 1000
  integer, parameter:: scale_factor_int_xx (0:3) = &
    & (/ 1, 1000, 1000000, 1000000000 /)
 
  type dc_scaled_sec
    sequence
    integer:: sec_ary(imin:imax) = 0
    logical:: flag_negative = .false.  
    logical:: dummy = .false.          
  end type dc_scaled_sec
 
  interface assignment(=)
    module procedure dcscaledseccreater !:doc-priority 20:
    module procedure dcscaledseccreated !:doc-priority 30:
    module procedure dcscaledseccreatei !:doc-priority 40:
 
    module procedure dcscaledsectonumr !:doc-priority 60:
    module procedure dcscaledsectonumd !:doc-priority 70:
    module procedure dcscaledsectonumi !:doc-priority 80:
  end interface
 
  interface putline
    module procedure dcscaledsecputline
  end interface
 
  interface operator(==)
    module procedure dcscaledsec_eq_ss !:doc-priority 20:
    module procedure dcscaledsec_eq_si !:doc-priority 61:
    module procedure dcscaledsec_eq_is !:doc-priority 62:
    module procedure dcscaledsec_eq_sr !:doc-priority 63:
    module procedure dcscaledsec_eq_rs !:doc-priority 64:
    module procedure dcscaledsec_eq_sd !:doc-priority 65:
    module procedure dcscaledsec_eq_ds !:doc-priority 66:
  end interface
 
  interface operator(>)
    module procedure dcscaledsec_gt_ss
    module procedure dcscaledsec_gt_si
    module procedure dcscaledsec_gt_is
  end interface
 
  interface operator(<)
    module procedure dcscaledsec_lt_ss
    module procedure dcscaledsec_lt_si
    module procedure dcscaledsec_lt_is
  end interface
 
  interface operator(>=)
    module procedure dcscaledsec_ge_ss
    module procedure dcscaledsec_ge_si
    module procedure dcscaledsec_ge_is
  end interface
 
  interface operator(<=)
    module procedure dcscaledsec_le_ss
    module procedure dcscaledsec_le_si
    module procedure dcscaledsec_le_is
  end interface
 
  interface operator(+)
    module procedure dcscaledsec_add_ss
    module procedure dcscaledsec_add_si
    module procedure dcscaledsec_add_is
    module procedure dcscaledsec_add_sr
    module procedure dcscaledsec_add_rs
    module procedure dcscaledsec_add_sd
    module procedure dcscaledsec_add_ds
  end interface
 
  interface operator(-)
    module procedure dcscaledsec_sub_s
    module procedure dcscaledsec_sub_ss
    module procedure dcscaledsec_sub_si
    module procedure dcscaledsec_sub_is
    module procedure dcscaledsec_sub_sr
    module procedure dcscaledsec_sub_rs
    module procedure dcscaledsec_sub_sd
    module procedure dcscaledsec_sub_ds
  end interface
 
  interface operator(*)
    module procedure dcscaledsec_mul_ss
    module procedure dcscaledsec_mul_si
    module procedure dcscaledsec_mul_is
    module procedure dcscaledsec_mul_sd
    module procedure dcscaledsec_mul_ds
    module procedure dcscaledsec_mul_sr
    module procedure dcscaledsec_mul_rs
  end interface
 
  interface operator(/)
    module procedure dcscaledsec_div_si
    module procedure dcscaledsec_div_sr
    module procedure dcscaledsec_div_sd
    module procedure dcscaledsec_div_ss
  end interface
 
  interface mod
    module procedure dcscaledsec_mod_si
    module procedure dcscaledsec_mod_sr
    module procedure dcscaledsec_mod_sd
    module procedure dcscaledsec_mod_ss
  end interface
 
  interface modulo
    module procedure dcscaledsec_modulo_si
    module procedure dcscaledsec_modulo_sr
    module procedure dcscaledsec_modulo_sd
    module procedure dcscaledsec_modulo_ss
  end interface
 
  interface abs
    module procedure dcscaledsec_abs_s
  end interface
 
  interface int
    module procedure dcscaledsec_int_s
  end interface
 
  interface sign
    module procedure dcscaledsec_sign_si
    module procedure dcscaledsec_sign_sr
    module procedure dcscaledsec_sign_sd
    module procedure dcscaledsec_sign_ss
  end interface
 
  interface floor
    module procedure dcscaledsec_floor_s
  end interface
 
  interface ceiling
    module procedure dcscaledsec_ceiling_s
  end interface
 
contains
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledseccreatei(sclsec, sec)
    implicit none
    type(dc_scaled_sec), intent(out):: sclsec
    integer, intent(in):: sec
  continue
    call dcscaledseccreated(sclsec, real( sec, dp ))
  end subroutine dcscaledseccreatei
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledseccreater(sclsec, sec)
    implicit none
    type(dc_scaled_sec), intent(out):: sclsec
    real, intent(in):: sec
  continue
    call dcscaledseccreated(sclsec, real( sec, dp ))
  end subroutine dcscaledseccreater
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledseccreated(sclsec, sec)
    use dc_message, only: messagenotify
    use dc_error, only: storeerror, dc_noerr, dc_etoolargetime
    use dc_trace, only: beginsub, endsub
    use dc_types, only: dp, string
    implicit none
    type(dc_scaled_sec), intent(out):: sclsec
    real(DP), intent(in):: sec
 
    real(DP):: work_sec, print_sec
    integer:: i, cd, move_up, work_sec_scl_nint
 
    integer :: stat
    character(STRING) :: cause_c
    character(*), parameter:: subname = 'dc_scaledsec'
  continue
    !call BeginSub(subname, 'sec=<%f>', d = (/ sec /) )
    stat = dc_noerr
    cause_c = ''
 
    cd = 0
    if ( sec < 0.0_dp ) then
      sclsec % flag_negative = .true.
      work_sec = - sec
    else
      sclsec % flag_negative = .false.
      work_sec = sec
    end if
 
    if ( work_sec > scale_factor_xx(imax + 1) ) then
      call messagenotify( 'W', subname, &
        & 'input number (%f) is too large.', &
        & d = (/ sec /) )
      stat = dc_etoolargetime
      goto 999
    end if
 
    sclsec % sec_ary = 0
    do i = imax, imin, -1
 
      work_sec_scl_nint = nint( work_sec * scale_factor_xx(-i) )
      if ( .not. work_sec < scale_factor_xx(i) &
        &  .or.  ( i == imin .and. work_sec_scl_nint >= 1 )  ) then
 
        if ( i < 0 ) then
          sclsec % sec_ary(i) = work_sec_scl_nint
        else
          sclsec % sec_ary(i) = int( work_sec / scale_factor_xx(i) )
        end if
        work_sec = work_sec - sclsec % sec_ary(i) * scale_factor_xx(i)
        cd = cd + count_digit( sclsec % sec_ary(i) )
      end if
      if ( cd > 5 ) then
        if ( .not. abs( work_sec ) < scale_factor_xx(i-1) ) then
          print_sec = sclsec
!!$          call MessageNotify( 'W', subname, &
!!$            & 'input number (%f) is truncated to (%f).', &
!!$            & d = (/ sec, print_sec /) )
        end if
        exit
      end if
    end do
 
    move_up = 0
    do i = imin, imax
      sclsec % sec_ary(i) = sclsec % sec_ary(i) + move_up
      move_up = 0
      do while ( sclsec % sec_ary(i) >= scale_factor_int )
        move_up = move_up + 1
        sclsec % sec_ary(i) = sclsec % sec_ary(i) - scale_factor_int
      end do
    end do
 
999 continue
    call storeerror(stat, subname, cause_c=cause_c)
    !call EndSub(subname)
  end subroutine dcscaledseccreated
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledsectonumi(sec, sclsec)
    use dc_types, only: dp
    implicit none
    integer, intent(out):: sec
    type(dc_scaled_sec), intent(in):: sclsec
    real(DP):: secd
  continue
    call dcscaledsectonumd(secd, sclsec)
    sec = nint( secd )
  end subroutine dcscaledsectonumi
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledsectonumr(sec, sclsec)
    use dc_types, only: dp
    implicit none
    real, intent(out):: sec
    type(dc_scaled_sec), intent(in):: sclsec
    real(DP):: secd
  continue
    call dcscaledsectonumd(secd, sclsec)
    sec = real( secd )
  end subroutine dcscaledsectonumr
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledsectonumd(sec, sclsec)
    use dc_types, only: dp
    implicit none
    real(DP), intent(out):: sec
    type(dc_scaled_sec), intent(in):: sclsec
 
    integer:: i
  continue
    sec = 0.0_dp
    do i = imax, imin, -1
      sec = sec + ( sclsec % sec_ary(i) * scale_factor_xx(i) )
    end do
    if ( sclsec % flag_negative ) sec = - sec
  end subroutine dcscaledsectonumd
 
  !-------------------------------------------------------------------
 
  subroutine dcscaledsecputline( sclsec, unit, indent )
    use dc_string, only: printf, tochar
    use dc_trace, only: beginsub, endsub
    use dc_types, only: stdout, string
    implicit none
    type(dc_scaled_sec), intent(in) :: sclsec
    integer, intent(in), optional :: unit
    character(*), intent(in), optional:: indent 
 
    integer :: out_unit, sec_ary_rev(imin:imax)
    integer:: indent_len
    character(STRING):: indent_str
    character(1):: sign
  continue
    !call BeginSub(subname)
 
    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
 
    sec_ary_rev(imin:imax) = sclsec % sec_ary(imax:imin:-1)
    if ( sclsec % flag_negative ) then
      sign = '-'
    else
      sign = '+'
    end if
    if ( imax - imin + 1 == 6 ) then
      call printf(out_unit, &
        & indent_str(1:indent_len) // &
        & '#<DC_SCALED_SEC:: @sign=%c @yotta=%d @exa=%d @tera=%d @mega=%d @base=%d @micro=%d>', &
        & i = sec_ary_rev, c1 = sign )
    elseif ( imax - imin + 1 == 11 ) then
      call printf(out_unit, &
        & indent_str(1:indent_len) // &
        & '#<DC_SCALED_SEC:: @sign=%c @yotta=%d @zetta=%d @exa=%d @peta=%d @tera=%d', &
        & i = sec_ary_rev(imin:imin+4), c1 = sign )
      call printf(out_unit, &
        & indent_str(1:indent_len) // &
        & '                          @giga=%d @mega=%d @kilo=%d @base=%d @milli=%d @micro=%d>', &
        & i = sec_ary_rev(imax-5:imax) )
    else
      call printf(out_unit, &
        & indent_str(1:indent_len) // &
        & '#<DC_SCALED_SEC:: @sign=%c @sec_ary=%*d>', &
        & i = sec_ary_rev, n = (/ imax - imin + 1 /), c1 = sign )
    end if
    !call EndSub(subname)
  end subroutine dcscaledsecputline
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
 
    integer:: i
  continue
    if ( sclsec1 % flag_negative .and. .not. sclsec2 % flag_negative ) then
      result = .false.
 
      return
    elseif ( .not. sclsec1 % flag_negative .and. sclsec2 % flag_negative ) then
      result = .false.
      return
    end if
 
    do i = imax, imin, -1
      if ( .not. sclsec1 % sec_ary(i) == sclsec2 % sec_ary(i) ) then
        result = .false.
        return
      end if
    end do
 
    result = .true.
  end function dcscaledsec_eq_ss
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_si(sclsec, sec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: sec
    type(dc_scaled_sec):: sclsec2
    integer:: i, sec1
  continue
    if ( sclsec % flag_negative .and. .not. sec < 0 ) then
      result = .false.
      return
    elseif ( .not. sclsec % flag_negative .and. sec < 0 ) then
      result = .false.
      return
    end if
 
    if ( abs(sec) > scale_factor_int_xx(3) ) then
      sclsec2 = sec
      result = sclsec == sclsec2
    else
      if (      .not. all( sclsec % sec_ary(imin:-1) == (/0, 0/) ) &
        &  .or. .not. all( sclsec % sec_ary(3:imax) == (/0, 0, 0, 0, 0, 0/) ) ) then
        result = .false.
        return
      end if
      sec1 = sclsec % sec_ary(0)
      do i = 1, 2
        sec1 = sec1 + sclsec % sec_ary(i) * scale_factor_int_xx(i)
      end do
      result = sec1 == sec
    end if
  end function dcscaledsec_eq_si
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_is(sec, sclsec) result(result)
    implicit none
    integer, intent(in):: sec
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = sclsec == sec
  end function dcscaledsec_eq_is
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_sr(sclsec, sec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: sec
    type(dc_scaled_sec):: sclsec2
  continue
    sclsec2 = sec
    result = sclsec == sclsec2
  end function dcscaledsec_eq_sr
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_rs(sec, sclsec) result(result)
    implicit none
    real, intent(in):: sec
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: sclsec2
  continue
    sclsec2 = sec
    result = sclsec == sclsec2
  end function dcscaledsec_eq_rs
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_sd(sclsec, sec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: sec
    type(dc_scaled_sec):: sclsec2
  continue
    sclsec2 = sec
    result = sclsec == sclsec2
  end function dcscaledsec_eq_sd
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_eq_ds(sec, sclsec) result(result)
    implicit none
    real(dp), intent(in):: sec
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: sclsec2
  continue
    sclsec2 = sec
    result = sclsec == sclsec2
  end function dcscaledsec_eq_ds
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_gt_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
 
    integer:: i
    logical:: both_negative, flag_equal
  continue
    result = .false.
    flag_equal = .true.
 
    if ( sclsec1 % flag_negative .and. .not. sclsec2 % flag_negative ) then
      result = .false.
      return
    elseif ( .not. sclsec1 % flag_negative .and. sclsec2 % flag_negative ) then
      result = .true.
      return
    elseif ( sclsec1 % flag_negative .and. sclsec2 % flag_negative ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    do i = imax, imin, -1
      if ( sclsec1 % sec_ary(i) > sclsec2 % sec_ary(i) ) then
        result = .true.
        flag_equal = .false.
        exit
      elseif ( sclsec1 % sec_ary(i) < sclsec2 % sec_ary(i) ) then
        result = .false.
        flag_equal = .false.
        exit
      end if
    end do
 
    if ( .not. flag_equal .and. both_negative ) result = .not. result
 
  end function dcscaledsec_gt_ss
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_gt_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
    integer:: i, sec1, factor_abs
    logical:: both_negative
  continue
    if ( sclsec % flag_negative .and. .not. factor < 0 ) then
      result = .false.
      return
    elseif ( .not. sclsec % flag_negative .and. factor < 0 ) then
      result = .true.
      return
    elseif ( sclsec % flag_negative .and. factor < 0 ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    factor_abs = abs(factor)
 
    if ( factor_abs > scale_factor_int_xx(3) ) then
      factor_scl = factor
      result = sclsec > factor_scl
      return
    else
      if ( .not. all( sclsec % sec_ary(3:imax) == (/0, 0, 0, 0, 0, 0/) ) ) then
        result = .true.
      else
        sec1 = sclsec % sec_ary(0)
        do i = 1, 2
          sec1 = sec1 + sclsec % sec_ary(i) * scale_factor_int_xx(i)
        end do
        if ( sec1 == factor_abs ) then
          result = .not. all( sclsec % sec_ary(imin:-1) == (/0, 0/) )
        else
          result = sec1 > factor_abs
        end if
      end if
 
      if ( both_negative ) result = .not. result
    end if
 
  end function dcscaledsec_gt_si
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_gt_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
    integer:: i, sec1, factor_abs
    logical:: both_negative
  continue
    if ( sclsec % flag_negative .and. .not. factor < 0 ) then
      result = .true.
      return
    elseif ( .not. sclsec % flag_negative .and. factor < 0 ) then
      result = .false.
      return
    elseif ( sclsec % flag_negative .and. factor < 0 ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    factor_abs = abs(factor)
 
    if ( factor_abs > scale_factor_int_xx(3) ) then
      factor_scl = factor
      result = factor_scl > sclsec
      return
    else
      if ( .not. all( sclsec % sec_ary(3:imax) == (/0, 0, 0, 0, 0, 0/) ) ) then
        result = .false.
      else
        sec1 = sclsec % sec_ary(0)
        do i = 1, 2
          sec1 = sec1 + sclsec % sec_ary(i) * scale_factor_int_xx(i)
        end do
        if ( sec1 == factor_abs ) then
          result = .false.
        else
          result = factor_abs > sec1
        end if
      end if
 
      if ( both_negative ) result = .not. result
    end if
  end function dcscaledsec_gt_is
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_lt_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
    integer:: i
    logical:: both_negative, flag_equal
  continue
    result = .false.
    flag_equal = .true.
 
    if ( sclsec1 % flag_negative .and. .not. sclsec2 % flag_negative ) then
      result = .true.
      return
    elseif ( .not. sclsec1 % flag_negative .and. sclsec2 % flag_negative ) then
      result = .false.
      return
    elseif ( sclsec1 % flag_negative .and. sclsec2 % flag_negative ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    do i = imax, imin, -1
      if ( sclsec1 % sec_ary(i) > sclsec2 % sec_ary(i) ) then
        result = .false.
        flag_equal = .false.
        exit
      elseif ( sclsec1 % sec_ary(i) < sclsec2 % sec_ary(i) ) then
        result = .true.
        flag_equal = .false.
        exit
      end if
    end do
 
    if ( .not. flag_equal .and. both_negative ) result = .not. result
 
  end function dcscaledsec_lt_ss
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_lt_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
    integer:: i, sec1, factor_abs
    logical:: both_negative
  continue
    if ( sclsec % flag_negative .and. .not. factor < 0 ) then
      result = .true.
      return
    elseif ( .not. sclsec % flag_negative .and. factor < 0 ) then
      result = .false.
      return
    elseif ( sclsec % flag_negative .and. factor < 0 ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    factor_abs = abs(factor)
 
    if ( factor_abs > scale_factor_int_xx(3) ) then
      factor_scl = factor
      result =  sclsec < factor_scl
      return
    else
      if ( .not. all( sclsec % sec_ary(3:imax) == (/0, 0, 0, 0, 0, 0/) ) ) then
        result = .false.
      else
        sec1 = sclsec % sec_ary(0)
        do i = 1, 2
          sec1 = sec1 + sclsec % sec_ary(i) * scale_factor_int_xx(i)
        end do
        if ( sec1 == factor_abs ) then
          result = .false.
        else
          result = sec1 < factor_abs
        end if
      end if
 
      if ( both_negative ) result = .not. result
    end if
  end function dcscaledsec_lt_si
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_lt_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
    integer:: i, sec1, factor_abs
    logical:: both_negative
  continue
    if ( sclsec % flag_negative .and. .not. factor < 0 ) then
      result = .false.
      return
    elseif ( .not. sclsec % flag_negative .and. factor < 0 ) then
      result = .true.
      return
    elseif ( sclsec % flag_negative .and. factor < 0 ) then
      both_negative = .true.
    else
      both_negative = .false.
    end if
 
    factor_abs = abs(factor)
 
    if ( factor_abs > scale_factor_int_xx(3) ) then
      factor_scl = factor
      result = factor_scl < sclsec
      return
    else
      if ( .not. all( sclsec % sec_ary(3:imax) == (/0, 0, 0, 0, 0, 0/) ) ) then
        result = .true.
      else
        sec1 = sclsec % sec_ary(0)
        do i = 1, 2
          sec1 = sec1 + sclsec % sec_ary(i) * scale_factor_int_xx(i)
        end do
        if ( sec1 == factor_abs ) then
          result = .not. all( sclsec % sec_ary(imin:-1) == (/0, 0/) )
        else
          result = factor_abs < sec1
        end if
      end if
 
      if ( both_negative ) result = .not. result
    end if
 
  end function dcscaledsec_lt_is
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_ge_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
  continue
    result = .not. sclsec1 < sclsec2
  end function dcscaledsec_ge_ss
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_ge_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
  continue
    result = .not. sclsec < factor
  end function dcscaledsec_ge_si
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_ge_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = .not. factor < sclsec
  end function dcscaledsec_ge_is
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_le_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
  continue
    result = .not. sclsec1 > sclsec2
  end function dcscaledsec_le_ss
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_le_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
  continue
    result = .not. sclsec > factor
  end function dcscaledsec_le_si
 
  !-------------------------------------------------------------------
 
  logical function dcscaledsec_le_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = .not. factor > sclsec
  end function dcscaledsec_le_is
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_ss(sclsec1, sclsec2) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
 
    integer:: i, move_up
    logical:: both_negative, sclsec2_flag_negative
    type(dc_scaled_sec):: sclsec1_opsign, sclsec2_opsign
  continue
    move_up = 0
    both_negative = .false.
 
    ! 負の値の処理
    ! Handle negative value
    !
    sclsec2_flag_negative = sclsec2 % flag_negative
    if ( sclsec1 % flag_negative ) then
      both_negative = .true.
      sclsec2_flag_negative = .not. sclsec2_flag_negative
    end if
    if ( sclsec2_flag_negative ) then
      sclsec1_opsign = sclsec1
      sclsec1_opsign % flag_negative = .false.
      sclsec2_opsign = sclsec2
      sclsec2_opsign % flag_negative = .false.
      result = sclsec1_opsign - sclsec2_opsign
      if ( both_negative ) then
        result % flag_negative = .not. result % flag_negative
      end if
      return
    end if
 
    ! 加算
    ! Addition
    !
    do i = imin, imax
      result % sec_ary(i) = sclsec1 % sec_ary(i) + sclsec2 % sec_ary(i) + move_up
      if ( .not. result % sec_ary(i) < scale_factor_int ) then
        if ( i == imax ) then
          call messagenotify( 'E', 'dc_scaledsec#operator(*)', &
            & 'DC_SCALED_SEC must be smaller than 10^24' )
        end if
        move_up = result % sec_ary(i) / scale_factor_int
        result % sec_ary(i) = mod( result % sec_ary(i), scale_factor_int )
      else
        move_up = 0
      end if
    end do
 
    if ( both_negative ) then
      result % flag_negative = .true.
    else
      result % flag_negative = .false.
    end if
 
  end function dcscaledsec_add_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec + factor_scl
  end function dcscaledsec_add_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = factor_scl + sclsec
  end function dcscaledsec_add_is
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_sr(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec + factor_scl
  end function dcscaledsec_add_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_rs(factor, sclsec) result(result)
    implicit none
    real, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec + factor_scl
  end function dcscaledsec_add_rs
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_sd(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec + factor_scl
  end function dcscaledsec_add_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_add_ds(factor, sclsec) result(result)
    implicit none
    real(dp), intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec + factor_scl
  end function dcscaledsec_add_ds
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_s(sclsec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result % flag_negative = .not. sclsec % flag_negative
    result % sec_ary = sclsec % sec_ary
  end function dcscaledsec_sub_s
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
 
    integer:: i, move_down
    logical:: both_negative, sclsec2_flag_negative
    type(dc_scaled_sec):: sclsec1_opsign, sclsec2_opsign
    type(dc_scaled_sec):: sclsec1_nosign, sclsec2_nosign
    type(dc_scaled_sec):: large, small
  continue
    both_negative = .false.
 
    ! 負の値の処理
    ! Handle negative value
    !
    sclsec2_flag_negative = sclsec2 % flag_negative
    if ( sclsec1 % flag_negative ) then
      both_negative = .true.
      sclsec2_flag_negative = .not. sclsec2_flag_negative
    end if
    if ( sclsec2_flag_negative ) then
      sclsec1_opsign = sclsec1
      sclsec1_opsign % flag_negative = .false.
      sclsec2_opsign = sclsec2
      sclsec2_opsign % flag_negative = .false.
 
      result = sclsec1_opsign + sclsec2_opsign
      if ( both_negative ) then
        result % flag_negative = .not. result % flag_negative
      end if
      return
    end if
 
    ! 絶対値の比較
    ! Compare absolute values
    !
    sclsec1_nosign = sclsec1
    sclsec1_nosign % flag_negative = .false.
    sclsec2_nosign = sclsec2
    sclsec2_nosign % flag_negative = .false.
 
    if ( sclsec1_nosign > sclsec2_nosign ) then
      result % flag_negative = .false.
      large = sclsec1_nosign
      small = sclsec2_nosign
    elseif ( sclsec1_nosign < sclsec2_nosign ) then
      result % flag_negative = .true.
      large = sclsec2_nosign
      small = sclsec1_nosign
    else
      result = 0
      return
    end if
 
    move_down = 0
    do i = imin, imax
      result % sec_ary(i) = large % sec_ary(i) - small % sec_ary(i) + move_down
      if ( result % sec_ary(i) < 0 ) then
        move_down = ( result % sec_ary(i) / scale_factor_int ) - 1
        result % sec_ary(i) = &
          & mod( result % sec_ary(i), scale_factor_int ) + scale_factor_int
      else
        move_down = 0
      end if
    end do
 
    if ( both_negative ) then
      result % flag_negative = .not. result % flag_negative
    end if
 
  end function dcscaledsec_sub_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec - factor_scl
  end function dcscaledsec_sub_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = factor_scl - sclsec
  end function dcscaledsec_sub_is
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_sr(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec - factor_scl
  end function dcscaledsec_sub_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_rs(factor, sclsec) result(result)
    implicit none
    real, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = factor_scl - sclsec
  end function dcscaledsec_sub_rs
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_sd(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec - factor_scl
  end function dcscaledsec_sub_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sub_ds(factor, sclsec) result(result)
    implicit none
    real(dp), intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = factor_scl - sclsec
  end function dcscaledsec_sub_ds
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_ss(sclsec1, sclsec2) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in), target:: sclsec1, sclsec2
    integer:: sec_ary_int(imin:imax,imin:imax)
!    real(DP):: sec_ary_int(imin:imax,imin:imax)
    integer:: i, j, move_up
    type(dc_scaled_sec):: zero_sec
  continue
    if ( sclsec1 == zero_sec .or. sclsec2 == zero_sec ) then
      result = zero_sec
      return
    end if
 
    if ( sclsec1 % flag_negative ) then
      result % flag_negative = .not. sclsec2 % flag_negative
    else
      result % flag_negative = sclsec2 % flag_negative
    end if
 
    move_up = 0
    sec_ary_int(:,:) = 0
    do i = imin, imax
      do j = imin, imax
        sec_ary_int(i,j) = &
          & sclsec1 % sec_ary(j) * sclsec2 % sec_ary(i) + move_up
        if ( i + j > imax .and. sec_ary_int(i,j) /= 0 ) then
          call messagenotify( 'E', 'dc_scaledsec#operator(*)', &
            & 'DC_SCALED_SEC must be smaller than 10^24' )
        end if
        if ( .not. sec_ary_int(i,j) < scale_factor ) then
          move_up = int( sec_ary_int(i,j) / scale_factor_int )
          sec_ary_int(i,j) = sec_ary_int(i,j) - move_up * scale_factor_int
        else
          move_up = 0
        end if
      end do
    end do
 
    result % sec_ary = 0 
    do i = imin, imax
      do j = imin, imax
        if ( i + j < imin ) cycle
        if ( i + j > imax ) cycle
        result % sec_ary(i+j) = result % sec_ary(i+j) + sec_ary_int(i,j)
      end do
    end do
 
    move_up = 0
    do i = imin, imax
      result % sec_ary(i) = result % sec_ary(i) + move_up
      move_up = 0
      do while ( .not. result % sec_ary(i) < scale_factor_int )
        if ( i == imax ) then
          call messagenotify( 'E', 'dc_scaledsec#operator(*)', &
            & 'DC_SCALED_SEC must be smaller than 10^24' )
        end if
        result % sec_ary(i) = result % sec_ary(i) - scale_factor_int
        move_up = move_up + 1
      end do
    end do
 
  end function dcscaledsec_mul_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_si(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    integer:: factor_abs
    type(dc_scaled_sec):: zero_sec
    real(dp):: sec_ary_dp(imin:imax)
    integer:: i, move_up
  continue
    if ( sclsec == zero_sec .or. factor == 0 ) then
      result = zero_sec
      return
    end if
 
    if ( sclsec % flag_negative ) then
      result % flag_negative = .not. factor < 0
    else
      result % flag_negative = factor < 0
    end if
    factor_abs = abs(factor)
 
    move_up = 0
    sec_ary_dp(:) = 0.0_dp
    do i = imin, imax
      sec_ary_dp(i) = sclsec % sec_ary(i) * factor_abs + move_up
 
      if ( .not. sec_ary_dp(i) < scale_factor ) then
        move_up = int( sec_ary_dp(i) / scale_factor )
        sec_ary_dp(i) = sec_ary_dp(i) - move_up * scale_factor
      else
        move_up = 0
      end if
    end do
 
    if ( move_up /= 0 ) then
      call messagenotify( 'E', 'dc_scaledsec#operator(*)', &
        & 'DC_SCALED_SEC must be smaller than 10^24' )
    end if
 
    result % sec_ary(imin:imax) = nint( sec_ary_dp(imin:imax) )
 
  end function dcscaledsec_mul_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_is(factor, sclsec) result(result)
    implicit none
    integer, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = sclsec * factor
  end function dcscaledsec_mul_is
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_sd(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec * factor_scl
  end function dcscaledsec_mul_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_ds(factor, sclsec) result(result)
    use dc_message, only: messagenotify
    implicit none
    real(dp), intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = sclsec * factor
  end function dcscaledsec_mul_ds
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_sr(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
  continue
    factor_scl = factor
    result = sclsec * factor_scl
  end function dcscaledsec_mul_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mul_rs(factor, sclsec) result(result)
    use dc_message, only: messagenotify
    implicit none
    real, intent(in):: factor
    type(dc_scaled_sec), intent(in):: sclsec
  continue
    result = sclsec * factor
  end function dcscaledsec_mul_rs
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_div_ss(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec, factor
    real(dp):: factor_abs
  continue
 
    ! frt, ifort などでは, 1.0e+23 などの実数とすると,
    ! 9.9999e+22 などとなってしまうため,
    ! factor として指定するものは 10e+12 までとする.
    !
    if ( .not. all( factor % sec_ary (imax-4:imax) == (/ 0, 0, 0, 0, 0 /) ) ) then
      call messagenotify( 'E', 'dc_scaledsec#mod', &
        & 'factor must be smaller than 10^12' )
    end if
 
    factor_abs = factor
    result = sclsec / factor_abs
 
  end function dcscaledsec_div_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_div_si(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
  continue
    result = sclsec / real( factor, dp )
  end function dcscaledsec_div_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_div_sd(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    use dc_types, only: dp_eps
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    integer:: i
    real(dp):: factor_abs, move_down, sec_ary_mod(imin+imin:imax)
    !logical:: flag_approximate
  continue
    if ( sclsec % flag_negative ) then
      result % flag_negative = .not. factor < 0.0_dp
    else
      result % flag_negative = factor < 0.0_dp
    end if
    factor_abs = abs(factor) * scale_factor_xx(2)
 
!    flag_approximate = .false.
    move_down = 0.0_dp
    do i = imax, imax + imin + 1, -1
      sec_ary_mod(i) = sclsec % sec_ary(i)
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
    end do
 
    do i = imax + imin, imin, -1
      result % sec_ary(i-imin) = int( ( sclsec % sec_ary(i) + move_down ) / factor_abs )
      sec_ary_mod(i) = &
        & mod( ( sclsec % sec_ary(i) + move_down ), factor_abs )
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        !if ( i < imin ) flag_approximate = .true.
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
    end do
 
    do i = imin - 1, imin + imin, -1
      result % sec_ary(i-imin) = int( move_down / factor_abs )
      sec_ary_mod(i) = mod( move_down, factor_abs )
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        !if ( i < imin ) flag_approximate = .true.
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
    end do
 
!!$    if ( flag_approximate ) then
!!$      call MessageNotify( 'W', 'dc_scaledsec#operator(/)', &
!!$        & 'result may be calculated approximately' )
!!$    end if
 
  end function dcscaledsec_div_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_div_sr(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
  continue
    result = sclsec / real( factor, dp )
  end function dcscaledsec_div_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mod_ss(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    use dc_types, only: dp_eps
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec, factor
 
    type(dc_scaled_sec):: factor_scl
    real(dp):: sec_ary_mod(imin+imin:imax)
    integer:: i, move_down_index, sf_idx
    real(dp):: move_down
    real(dp):: factor_dp
    type(dc_scaled_sec):: zero_sec
    logical:: done
  continue
 
    ! factor must be smaller than 10^12 due to compiler precision limitations.
    !
    if ( .not. all( factor % sec_ary (imax-4:imax) == (/ 0, 0, 0, 0, 0 /) ) ) then
      call messagenotify( 'E', 'dc_scaledsec#mod', &
        & 'factor must be smaller than 10^12' )
    end if
 
    if ( sclsec == factor ) then
      result = zero_sec
      return
    end if
 
    factor_scl % sec_ary(imin:-1) = 0
    factor_scl % sec_ary(imin-imin:imax) = factor % sec_ary(imin:imax+imin)
    factor_scl % flag_negative = factor % flag_negative
 
    factor_dp = factor_scl
 
    done = .false.
    move_down = 0.0_dp
    do i = imax, imin, -1
      move_down_index = i
      if ( abs(move_down) > dp_eps ) then
        sf_idx = i - imin
        if ( sf_idx > ubound(scale_factor_xx, 1) ) sf_idx = ubound(scale_factor_xx, 1)
        if ( sf_idx < lbound(scale_factor_xx, 1) ) sf_idx = lbound(scale_factor_xx, 1)
        if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( sf_idx ) ) then
          done = .true.
          exit
        end if
      end if
 
      sec_ary_mod(i) = &
        & mod( ( sclsec % sec_ary(i) + move_down ), factor_dp )
 
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
    end do
 
    if ( .not. done ) then
      do i = imin - 1, imin + imin, -1
      move_down_index = i
      if ( abs(move_down) > dp_eps ) then
        sf_idx = i - imin
        if ( sf_idx > ubound(scale_factor_xx, 1) ) sf_idx = ubound(scale_factor_xx, 1)
        if ( sf_idx < lbound(scale_factor_xx, 1) ) sf_idx = lbound(scale_factor_xx, 1)
        if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( sf_idx ) ) then
          done = .true.
          exit
        end if
      end if
 
      sec_ary_mod(i) = mod( move_down, factor_dp )
 
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
      end do
    end if
 
    result = move_down * scale_factor_xx(move_down_index)
    if ( move_down_index > imin - 1 ) then
      result % sec_ary(imin:move_down_index) = sclsec % sec_ary(imin:move_down_index)
    end if
 
    result % flag_negative = sclsec % flag_negative
 
  end function dcscaledsec_mod_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mod_si(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = mod( sclsec, factor_scl )
  end function dcscaledsec_mod_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mod_sr(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = mod( sclsec, factor_scl )
  end function dcscaledsec_mod_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_mod_sd(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = mod( sclsec, factor_scl )
  end function dcscaledsec_mod_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_modulo_ss(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    use dc_types, only: dp_eps
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec, factor
 
    type(dc_scaled_sec):: factor_scl
    real(dp):: sec_ary_mod(imin+imin:imax)
    integer:: i, move_down_index, sf_idx
    real(dp):: move_down
    real(dp):: factor_dp
    type(dc_scaled_sec):: zero_sec
    logical:: done
  continue
 
    ! factor must be smaller than 10^12 due to compiler precision limitations.
    !
    if ( .not. all( factor % sec_ary (imax-4:imax) == (/ 0, 0, 0, 0, 0 /) ) ) then
      call messagenotify( 'E', 'dc_scaledsec#modulo', &
        & 'factor must be smaller than 10^12' )
    end if
 
    if ( sclsec == factor ) then
      result = zero_sec
      return
    end if
 
    factor_scl % sec_ary(imin:-1) = 0
    factor_scl % sec_ary(imin-imin:imax) = factor % sec_ary(imin:imax+imin)
    factor_scl % flag_negative = factor % flag_negative
 
    factor_dp = factor_scl
 
    done = .false.
    move_down = 0.0_dp
    do i = imax, imin, -1
      move_down_index = i
      if ( abs(move_down) > dp_eps ) then
        sf_idx = i - imin
        if ( sf_idx > ubound(scale_factor_xx, 1) ) sf_idx = ubound(scale_factor_xx, 1)
        if ( sf_idx < lbound(scale_factor_xx, 1) ) sf_idx = lbound(scale_factor_xx, 1)
        if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( sf_idx ) ) then
          done = .true.
          exit
        end if
      end if
 
      sec_ary_mod(i) = &
        & mod( ( sclsec % sec_ary(i) + move_down ), factor_dp )
 
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
    end do
 
    if ( .not. done ) then
      do i = imin - 1, imin + imin, -1
      move_down_index = i
      if ( abs(move_down) > dp_eps ) then
        sf_idx = i - imin
        if ( sf_idx > ubound(scale_factor_xx, 1) ) sf_idx = ubound(scale_factor_xx, 1)
        if ( sf_idx < lbound(scale_factor_xx, 1) ) sf_idx = lbound(scale_factor_xx, 1)
        if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( sf_idx ) ) then
          done = .true.
          exit
        end if
      end if
 
      sec_ary_mod(i) = mod( move_down, factor_dp )
 
      if ( abs(sec_ary_mod(i)) > dp_eps ) then
        move_down = sec_ary_mod(i) * scale_factor
      else
        move_down = 0.0_dp
      end if
      end do
    end if
 
    result = move_down * scale_factor_xx(move_down_index)
    if ( move_down_index > imin - 1 ) then
      result % sec_ary(imin:move_down_index) = sclsec % sec_ary(imin:move_down_index)
    end if
    
    result % flag_negative = .false.
 
    if ( .not. result == zero_sec ) then
      if ( .not. sclsec % flag_negative .and. factor % flag_negative ) then
        result = - factor - result
        result % flag_negative = .not. sclsec % flag_negative
        
      elseif ( sclsec % flag_negative .and. .not. factor % flag_negative ) then
        result = factor - result
        result % flag_negative = .not. sclsec % flag_negative
 
      else
        result % flag_negative = sclsec % flag_negative
        
      end if
    end if
 
  end function dcscaledsec_modulo_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_modulo_si(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = modulo( sclsec, factor_scl )
  end function dcscaledsec_modulo_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_modulo_sr(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = modulo( sclsec, factor_scl )
  end function dcscaledsec_modulo_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_modulo_sd(sclsec, factor) result(result)
    use dc_message, only: messagenotify
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: factor_scl
 
  continue
    factor_scl = factor
    result = modulo( sclsec, factor_scl )
  end function dcscaledsec_modulo_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_abs_s(sclsec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
 
  continue
    result = sclsec
    if ( result % flag_negative ) result % flag_negative = .false.
  end function dcscaledsec_abs_s
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_int_s(sclsec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer:: i
  continue
    result = sclsec
    do i = -1, imin, -1
      result % sec_ary(i) = 0
    end do
  end function dcscaledsec_int_s
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sign_ss(sclsec1, sclsec2) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec1, sclsec2
  continue
    result = sclsec1
    result % flag_negative = sclsec2 % flag_negative
  end function dcscaledsec_sign_ss
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sign_si(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer, intent(in):: factor
    type(dc_scaled_sec):: sclsec_work
  continue
    sclsec_work = factor
    result = sign( sclsec, sclsec_work )
  end function dcscaledsec_sign_si
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sign_sr(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real, intent(in):: factor
    type(dc_scaled_sec):: sclsec_work
  continue
    sclsec_work = factor
    result = sign( sclsec, sclsec_work )
  end function dcscaledsec_sign_sr
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_sign_sd(sclsec, factor) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    real(dp), intent(in):: factor
    type(dc_scaled_sec):: sclsec_work
  continue
    sclsec_work = factor
    result = sign( sclsec, sclsec_work )
  end function dcscaledsec_sign_sd
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_floor_s(sclsec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer:: i
    logical:: flag_after_decimal
  continue
    result = sclsec
    flag_after_decimal = .false.
    do i = -1, imin, -1
      if ( result % sec_ary(i) /= 0 ) flag_after_decimal = .true.
      result % sec_ary(i) = 0
    end do
    if ( flag_after_decimal .and. result % flag_negative ) then
      result = result - 1
    end if
 
  end function dcscaledsec_floor_s
 
  !-------------------------------------------------------------------
 
  type(dc_scaled_sec) function dcscaledsec_ceiling_s(sclsec) result(result)
    implicit none
    type(dc_scaled_sec), intent(in):: sclsec
    integer:: i
    logical:: flag_after_decimal
  continue
    result = sclsec
    flag_after_decimal = .false.
    do i = -1, imin, -1
      if ( result % sec_ary(i) /= 0 ) flag_after_decimal = .true.
      result % sec_ary(i) = 0
    end do
    if ( flag_after_decimal .and. .not. result % flag_negative ) then
      result = result + 1
    end if
 
  end function dcscaledsec_ceiling_s
 
  !-------------------------------------------------------------------
  !-----------------  内部サブルーチン  ------------------------------
  !  Internal subroutines
  !-------------------------------------------------------------------
 
  function count_digit(sec) result(result)
    implicit none
    integer, intent(in):: sec
    integer:: result
 
    integer:: i
  continue
 
    do i = 5, 0, -1
      if ( .not. sec < 10**i ) then
        result = i+1
        return
      end if
    end do
    result = 0
 
  end function count_digit
 
end module dc_scaledsec