| Class | dc_scaledsec |
| In: |
dc_utils/dc_scaledsec.f90
|
| assignment(=) : | 代入 |
| operator(+) : | 加算 |
| operator(-) : | 減算 |
| operator(*) : | 乗算 |
| operator(/) : | 除算 |
| mod : | 余り |
| modulo : | 剰余 |
| operator(==) : | 比較 |
| operator(>) : | 比較 |
| operator(<) : | 比較 |
| abs : | 絶対値の算出 |
| int : | 整数の算出 (小数点以下切捨て) |
| sign : | 符号の設定 |
| floor : | 整数の算出 (対象の数値以下で最大の整数) |
| ceiling : | 整数の算出 (対象の数値以上で最小の整数) |
| Subroutine : | |||
| sclsec : | type(DC_SCALED_SEC), intent(in) | ||
| unit : | integer, intent(in), optional
| ||
| indent : | character(*), intent(in), optional
|
引数 sclsec に設定されている情報を印字します. デフォルトではメッセージは標準出力に出力されます. unit に装置番号を指定することで, 出力先を変更することが可能です.
Print information of sclsec. By default messages are output to standard output. Unit number for output can be changed by unit argument.
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
| 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.
| 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
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
| Subroutine : | |
| sclsec : | type(DC_SCALED_SEC), intent(out) |
| sec : | real, intent(in) |
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 : | |
| sclsec : | type(DC_SCALED_SEC), intent(out) |
| sec : | real(DP), intent(in) |
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 : | |
| sclsec : | type(DC_SCALED_SEC), intent(out) |
| sec : | integer, intent(in) |
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 : | |
| sec : | real, intent(out) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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 : | |
| sec : | real(DP), intent(out) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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 : | |
| sec : | integer, intent(out) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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
| 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
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
| 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
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
| 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
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
DC_SCALED_SEC 型変数を割った際の余りを計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mod_si(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の余りを計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
DC_SCALED_SEC 型変数を割った際の余りを計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mod_sd(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の余りを計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
DC_SCALED_SEC 型変数を割った際の余りを計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mod_sr(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の余りを計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数を割った際の余りを計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mod_ss(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の余りを計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
use dc_message, only: MessageNotify
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
real(DP):: move_down
real(DP):: factor_dp
type(DC_SCALED_SEC):: zero_sec
continue
! frt, ifort などでは, 1.0e+23 などの実数とすると,
! 9.9999e+22 などとなってしまうため,
! factor として指定するものは 10e+12 までとする. (うーむ, 汚い対応だな....)
! (morikawa 2008/09/01)
!
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
move_down = 0.0_DP
do i = imax, imin + imin, -1
move_down_index = i
if ( move_down /= 0.0_DP ) then
if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( i - imin ) ) exit
end if
if ( i > imin - 1 ) then
sec_ary_mod(i) = mod( ( sclsec % sec_ary(i) + move_down ), factor_dp )
else
sec_ary_mod(i) = mod( move_down, factor_dp )
end if
if ( sec_ary_mod(i) /= 0.0_DP ) then
move_down = sec_ary_mod(i) * scale_factor
else
move_down = 0.0_DP
end if
end do
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
DC_SCALED_SEC 型変数を割った際の剰余を計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_modulo_si(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の剰余を計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
DC_SCALED_SEC 型変数を割った際の剰余を計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_modulo_sd(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の剰余を計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
DC_SCALED_SEC 型変数を割った際の剰余を計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_modulo_sr(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の剰余を計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数を割った際の剰余を計算.
Calculate of remainder by division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_modulo_ss(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数を割った際の剰余を計算.
!
! Calculate of remainder by division of a "DC_SCALED_SEC" variable
!
use dc_message, only: MessageNotify
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
real(DP):: move_down
real(DP):: factor_dp
type(DC_SCALED_SEC):: zero_sec
continue
! frt, ifort などでは, 1.0e+23 などの実数とすると,
! 9.9999e+22 などとなってしまうため,
! factor として指定するものは 10e+12 までとする. (うーむ, 汚い対応だな....)
! (morikawa 2008/09/01)
!
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
move_down = 0.0_DP
do i = imax, imin + imin, -1
move_down_index = i
if ( move_down /= 0.0_DP ) then
if ( abs(factor_dp) > ( move_down + scale_factor ) * scale_factor_xx( i - imin ) ) exit
end if
if ( i > imin - 1 ) then
sec_ary_mod(i) = mod( ( sclsec % sec_ary(i) + move_down ), factor_dp )
else
sec_ary_mod(i) = mod( move_down, factor_dp )
end if
if ( sec_ary_mod(i) /= 0.0_DP ) then
move_down = sec_ary_mod(i) * scale_factor
else
move_down = 0.0_DP
end if
end do
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_is(factor, sclsec) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
implicit none
integer, intent(in):: factor
type(DC_SCALED_SEC), intent(in):: sclsec
continue
result = sclsec * factor
end function dcscaledsec_mul_is
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real(DP), intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_ds(factor, sclsec) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_rs(factor, sclsec) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_si(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
!
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) = sec_ary_dp(imin:imax)
end function dcscaledsec_mul_si
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_sd(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_sr(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec1 : | type(DC_SCALED_SEC), intent(in), target |
| sclsec2 : | type(DC_SCALED_SEC), intent(in), target |
DC_SCALED_SEC 型変数の乗算.
Multiplication of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_mul_ss(sclsec1, sclsec2) result(result)
!
! DC_SCALED_SEC 型変数の乗算.
!
! Multiplication of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real(DP), intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_ds(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_rs(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_sd(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_sr(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の加算.
Addition of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_add_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の加算.
!
! Addition of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real(DP), intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_ds(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| factor : | real, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_rs(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数の符号を逆にする.
Inverse sign of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_sub_s(sclsec) result(result)
!
! DC_SCALED_SEC 型変数の符号を逆にする.
!
! Inverse sign of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_sd(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_sr(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の減算.
Subtraction of two "DC_SCALED_SEC" variables
type(DC_SCALED_SEC) function dcscaledsec_sub_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の減算.
!
! Subtraction of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
DC_SCALED_SEC 型変数の除算.
Division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_div_si(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の除算.
!
! Division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
DC_SCALED_SEC 型変数の除算.
Division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_div_sd(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の除算.
!
! Division of a "DC_SCALED_SEC" variable
!
use dc_message, only: MessageNotify
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, imin + imin, -1
if ( i > imax + imin ) then
sec_ary_mod(i) = sclsec % sec_ary(i)
elseif ( i > imin - 1 ) then
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 )
else
result % sec_ary(i-imin) = int( move_down / factor_abs )
sec_ary_mod(i) = mod( move_down, factor_abs )
end if
if ( sec_ary_mod(i) /= 0.0_DP ) 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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
DC_SCALED_SEC 型変数の除算.
Division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_div_sr(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の除算.
!
! Division of a "DC_SCALED_SEC" variable
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | type(DC_SCALED_SEC), intent(in) |
DC_SCALED_SEC 型変数の除算.
Division of a "DC_SCALED_SEC" variable
type(DC_SCALED_SEC) function dcscaledsec_div_ss(sclsec, factor) result(result)
!
! DC_SCALED_SEC 型変数の除算.
!
! Division of a "DC_SCALED_SEC" variable
!
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 までとする. (うーむ, 汚い対応だな....)
! (morikawa 2008/09/01)
!
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
| Function : | |
| result : | logical |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_lt_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_lt_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_lt_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_le_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
integer, intent(in):: factor
type(DC_SCALED_SEC), intent(in):: sclsec
continue
result = .not. factor > sclsec
end function dcscaledsec_le_is
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_le_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
type(DC_SCALED_SEC), intent(in):: sclsec
integer, intent(in):: factor
continue
result = .not. sclsec > factor
end function dcscaledsec_le_si
| Function : | |
| result : | logical |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_le_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
type(DC_SCALED_SEC), intent(in):: sclsec1, sclsec2
continue
result = .not. sclsec1 > sclsec2
end function dcscaledsec_le_ss
| Function : | |
| result : | logical |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_eq_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| sec : | integer, intent(in) |
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
| Function : | |
| result : | logical |
| sec : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| sec : | real, intent(in) |
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
| Function : | |
| result : | logical |
| sec : | real, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| sec : | real(DP), intent(in) |
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
| Function : | |
| result : | logical |
| sec : | real(DP), intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
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
| Function : | |
| result : | logical |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_gt_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_gt_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_gt_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
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
| Function : | |
| result : | logical |
| factor : | integer, intent(in) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_ge_is(factor, sclsec) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
integer, intent(in):: factor
type(DC_SCALED_SEC), intent(in):: sclsec
continue
result = .not. factor < sclsec
end function dcscaledsec_ge_is
| Function : | |
| result : | logical |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_ge_si(sclsec, factor) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
type(DC_SCALED_SEC), intent(in):: sclsec
integer, intent(in):: factor
continue
result = .not. sclsec < factor
end function dcscaledsec_ge_si
| Function : | |
| result : | logical |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
2 つの DC_SCALED_SEC 型変数の比較
Comparison of two "DC_SCALED_SEC" variables
logical function dcscaledsec_ge_ss(sclsec1, sclsec2) result(result)
!
! 2 つの DC_SCALED_SEC 型変数の比較
!
! Comparison of two "DC_SCALED_SEC" variables
!
implicit none
type(DC_SCALED_SEC), intent(in):: sclsec1, sclsec2
continue
result = .not. sclsec1 < sclsec2
end function dcscaledsec_ge_ss
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | integer, intent(in) |
sclsec の絶対値に factor の符号をつけたものを返す.
Return an absolute value of "sclsec" with sign of "factor".
type(DC_SCALED_SEC) function dcscaledsec_sign_si(sclsec, factor) result(result)
!
! sclsec の絶対値に factor の符号をつけたものを返す.
!
! Return an absolute value of "sclsec" with sign of "factor".
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real(DP), intent(in) |
sclsec の絶対値に factor の符号をつけたものを返す.
Return an absolute value of "sclsec" with sign of "factor".
type(DC_SCALED_SEC) function dcscaledsec_sign_sd(sclsec, factor) result(result)
!
! sclsec の絶対値に factor の符号をつけたものを返す.
!
! Return an absolute value of "sclsec" with sign of "factor".
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec : | type(DC_SCALED_SEC), intent(in) |
| factor : | real, intent(in) |
sclsec の絶対値に factor の符号をつけたものを返す.
Return an absolute value of "sclsec" with sign of "factor".
type(DC_SCALED_SEC) function dcscaledsec_sign_sr(sclsec, factor) result(result)
!
! sclsec の絶対値に factor の符号をつけたものを返す.
!
! Return an absolute value of "sclsec" with sign of "factor".
!
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
| Function : | |
| result : | type(DC_SCALED_SEC) |
| sclsec1 : | type(DC_SCALED_SEC), intent(in) |
| sclsec2 : | type(DC_SCALED_SEC), intent(in) |
sclsec1 の絶対値に sclsec2 の符号をつけたものを返す.
Return an absolute value of "sclsec1" with sign of "sclsec2".
type(DC_SCALED_SEC) function dcscaledsec_sign_ss(sclsec1, sclsec2) result(result)
!
! sclsec1 の絶対値に sclsec2 の符号をつけたものを返す.
!
! Return an absolute value of "sclsec1" with sign of "sclsec2".
!
implicit none
type(DC_SCALED_SEC), intent(in):: sclsec1, sclsec2
continue
result = sclsec1
result % flag_negative = sclsec2 % flag_negative
end function dcscaledsec_sign_ss