Class: dc_scaledsec

DCScaledSecPutLine( sclsec, [unit], [indent] )

Subroutine :

sclsec : type(DC_SCALED_SEC), intent(in)

unit :

integer, intent(in), optional

:	出力先の装置番号. デフォルトの出力先は標準出力. Unit number for output. Default value is standard output.

indent :

character(*), intent(in), optional

:	表示されるメッセージの字下げ. Indent of displayed messages.

引数 sclsec に設定されている情報を印字します. デフォルトではメッセージは標準出力に出力されます. unit に装置番号を指定することで, 出力先を変更することが可能です.

Print information of sclsec. By default messages are output to standard output. Unit number for output can be changed by unit argument.

[Source]

  subroutine DCScaledSecPutLine( sclsec, unit, indent )
    !
    ! 引数 *sclsec* に設定されている情報を印字します. 
    ! デフォルトではメッセージは標準出力に出力されます. 
    ! *unit* に装置番号を指定することで, 出力先を変更することが可能です. 
    !
    ! Print information of *sclsec*. 
    ! By default messages are output to standard output. 
    ! Unit number for output can be changed by *unit* argument. 
    !
    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
                              ! 出力先の装置番号. 
                              ! デフォルトの出力先は標準出力. 
                              !
                              ! Unit number for output. 
                              ! Default value is standard output. 
    character(*), intent(in), optional:: indent
                              ! 表示されるメッセージの字下げ. 
                              !
                              ! Indent of displayed messages. 

    integer :: out_unit, sec_ary_rev(imin:imax)
    integer:: indent_len
    character(STRING):: indent_str
    character(1):: sign
    character(*), parameter:: subname = 'DCScaledSecPutLine'
  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
  999 continue
    !call EndSub(subname)
  end subroutine DCScaledSecPutLine

DC_SCALED_SEC

*Derived Type* :
`sec_ary(imin:imax)` `= 0` :	`integer`
`flag_negative` `= .false.` :	`logical`
`dummy` `= .false.` :	`logical`

小数点以下の「秒」や, 整数型では表現できないほど大きい数を正確に演算するための型.

Derived type for precise operations of "seconds" after the decimal point, and large number more than integer type.

abs( sclsec ) result(result)

*Function* :
`result` :	`type(DC_SCALED_SEC)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

DC_SCALED_SEC 型変数の絶対値を返す.

Return an absolute value of a "DC_SCALED_SEC" variable

[Source]

  type(DC_SCALED_SEC) function dcscaledsec_abs_s(sclsec) result(result)
    !
    ! DC_SCALED_SEC 型変数の絶対値を返す. 
    ! 
    ! Return an absolute value of a "DC_SCALED_SEC" variable
    !
    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

assignment(=)( sclsec, sec )

*Subroutine* :
`sclsec` :	`type(DC_SCALED_SEC), intent(out)`
`sec` :	`real, intent(in)`

[Source]

  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

assignment(=)( sclsec, sec )

*Subroutine* :
`sclsec` :	`type(DC_SCALED_SEC), intent(out)`
`sec` :	`real(DP), intent(in)`

[Source]

  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

assignment(=)( sclsec, sec )

*Subroutine* :
`sclsec` :	`type(DC_SCALED_SEC), intent(out)`
`sec` :	`integer, intent(in)`

[Source]

  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

assignment(=)( sec, sclsec )

*Subroutine* :
`sec` :	`real, intent(out)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

[Source]

  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

assignment(=)( sec, sclsec )

*Subroutine* :
`sec` :	`real(DP), intent(out)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

[Source]

  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

assignment(=)( sec, sclsec )

*Subroutine* :
`sec` :	`integer, intent(out)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

[Source]

  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

ceiling( sclsec ) result(result)

*Function* :
`result` :	`type(DC_SCALED_SEC)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

DC_SCALED_SEC 型変数の整数値 (対象の数値以上で最小の整数) を返す.

Return an integer value (minimum integer over the given value) of a "DC_SCALED_SEC" variable

[Source]

  type(DC_SCALED_SEC) function dcscaledsec_ceiling_s(sclsec) result(result)
    !
    ! DC_SCALED_SEC 型変数の整数値 (対象の数値以上で最小の整数) を返す. 
    ! 
    ! Return an integer value (minimum integer over the given value) 
    ! of a "DC_SCALED_SEC" variable
    !
    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

floor( sclsec ) result(result)

*Function* :
`result` :	`type(DC_SCALED_SEC)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

DC_SCALED_SEC 型変数の整数値 (対象の数値以下で最大の整数) を返す.

Return an integer value (maximum integer under the given value) of a "DC_SCALED_SEC" variable

[Source]

  type(DC_SCALED_SEC) function dcscaledsec_floor_s(sclsec) result(result)
    !
    ! DC_SCALED_SEC 型変数の整数値 (対象の数値以下で最大の整数) を返す. 
    ! 
    ! Return an integer value (maximum integer under the given value) 
    ! of a "DC_SCALED_SEC" variable
    !
    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

int( sclsec ) result(result)

*Function* :
`result` :	`type(DC_SCALED_SEC)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`

DC_SCALED_SEC 型変数の整数値 (小数点以下切捨て) を返す.

Return an integer value (fractional parts are truncated) of a "DC_SCALED_SEC" variable

[Source]

  type(DC_SCALED_SEC) function dcscaledsec_int_s(sclsec) result(result)
    !
    ! DC_SCALED_SEC 型変数の整数値 (小数点以下切捨て) を返す. 
    ! 
    ! Return an integer value (fractional parts are truncated) of a "DC_SCALED_SEC" variable
    !
    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

mod( sclsec, factor ) result(result)

*Function* :
`result` :	`type(DC_SCALED_SEC)`
`sclsec` :	`type(DC_SCALED_SEC), intent(in)`
`factor` :	`integer, intent(in)`

DC_SCALED_SEC 型変数を割った際の余りを計算.