Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
quad_3.bi
| Uploader: |  Volta |
| Datum/Zeit: | 21.10.2010 10:58:35 |
Function quad_string(ByRef value As quad) As String
' convert a quadruple-precision quantity to a decimal character string.
' error indicator ier = 0 if conversion ok
' = 1 if the length of the string < 36 characters.
Dim As ZString * 2 sign
Dim As ZString * 18 str1, str2
Dim As String strng
Dim As quad vl, v
Dim As Integer dec_expnt, i, ier
Dim As Double tmp
ier = 0
' check if value = zero.
If (value.hi = zero) Then
strng = " 0.00"
Return strng
End If
If (value.hi < 0) Then
sign = "-"
vl.hi = - value.hi
vl.lo = - value.lo
Else
sign = " "
vl = value
End If
' use log10 to set the exponent.
dec_expnt = FBfloor( Log(vl.hi)*0.4342944819032518 )
' get the first 15 decimal digits
If (dec_expnt <> 14) Then
v=longlog(cquad(10.0, zero))
v=mult_quad_dp(v,(14 - dec_expnt))
v=longexp(v)
vl = longmul(vl , v )
End If
str1=Format( vl.hi,"################")
' calculate the remainder
tmp =Val(str1+".0#")
vl = quad_sub_dp(vl , tmp)
' if vl is -ve, subtract 1 from the last digit of str1, and add 1 to vl.
If (vl.hi < -0.5d-16) Then
tmp = tmp - one
str1=Format( tmp,"################")
vl = quad_add_dp(vl , one)
End If
vl = mult_quad_dp(vl , 1.d15)
' write the second 15 digits
str2=Format( vl.hi,"################")
' end if
If Len(str2)<15 Then
str2=String(15-Len(str2),"0")+str2
End If
' if str2 consists of asterisks, add 1 in the last digit to str1.
' set str2 to zeroes.
If (Len(str2)>15) Then
tmp = tmp + one
str1=Format( tmp,"#################")
If (Left(str1,1) <> " ") Then
'dec_expnt = dec_expnt + 1
Else
str1 = Mid(str1,2)
End If
str2 = "000000000000000"
End If
strng = sign+Left(str1,1)+"."+Mid(str1,2)+str2
If dec_expnt>=0 Then
strng=strng+"e+"+Str(dec_expnt)
Else
strng=strng+"e"+Str(dec_expnt)
End If
' replace leading blanks with zeroes
'do i = 1, 15
' if (str2(i:i) /= ' ') exit
' str2(i:i) = '0'
'end do
'
'' combine str1 & str2, removing decimal points & adding exponent.
'i = index(str1, '.')
'str1(i:i) = ' '
'str2(16:16) = ' '
'strng = '.' // trim(adjustl(str1)) // trim(adjustl(str2)) // 'e'
'write(str1, '(i4.2)') dec_expnt+1
'strng = trim(strng) // adjustl(str1)
'
'' restore the sign.
'if (sign = '-') then
' strng = '-' // adjustl(strng)
'else
' strng = adjustl(strng)
'end if
Return strng
End Function
'##############################################################################
Function string_quad(Byref value As String) As quad
Dim As quad qd, pt
Dim As Integer j, s, d, e, ep, ex, es, i, f, fp, fln
Dim As String c, f1, f2, f3, f4, vl
j=1
s=1
d=0
e=0
ep=0
ex=0
es=1
i=0
f=0
fp=0
f1=""
f2=""
f3=""
vl=Ucase(value)
fln=Len(vl)
While j<=fln
c=Mid(vl,j,1)
If ep=1 Then
If c=" " Then
Goto atof1nxtch
Endif
If c="-" Then
es=-es
c=""
Endif
If c="+" Then
Goto atof1nxtch
Endif
If (c="0") And (f3="") Then
Goto atof1nxtch
Endif
If (c>"/") And (c<":") Then 'c is digit between 0 and 9
f3=f3+c
ex=10*ex+(Asc(c)-48)
Goto atof1nxtch
Endif
Endif
If c=" " Then
Goto atof1nxtch
Endif
If c="-" Then
s=-s
Goto atof1nxtch
Endif
If c="+" Then
Goto atof1nxtch
Endif
If c="." Then
If d=1 Then
Goto atof1nxtch
Endif
d=1
Endif
If (c>"/") And (c<":") Then 'c is digit between 0 and 9
If ((c="0") And (i=0)) Then
If d=0 Then
Goto atof1nxtch
Endif
If (d=1) And (f=0) Then
e=e-1
Goto atof1nxtch
Endif
Endif
If d=0 Then
f1=f1+c
i=i+1
Else
If (c>"0") Then
fp=1
Endif
f2=f2+c
f=f+1
Endif
Endif
If c="E" Then
ep=1
Endif
atof1nxtch:
j=j+1
Wend
If fp=0 Then
f=0
f2=""
Endif
ex=es*ex-1+i+e
f1=f1+f2
If Len(f1)>33 Then
f1=Mid(f1,1,33)
Endif
While Len(f1)<33
f1=f1+"0"
Wend
c=Mid(f1,1,30)
f2=Left(c,15)
f3=Right(c,15)
f4=right(f1,3)
qd.hi=Val(f2)
qd.lo=0
qd=mult_quad_dp(qd, 1000000000000000)
qd=quad_add_dp(qd, Val(f3))
qd=mult_quad_dp(qd, 1000)
qd=quad_add_dp(qd, Val(f4))
pt = cquad(10.0, 0.0)
pt = quad_pow_int(pt, 32)
qd=longdiv(qd,pt)
pt = cquad(10.0, 0.0)
pt = quad_pow_int(pt, ex)
qd=longmul(qd,pt)
if s=-1 then
qd.hi=-qd.hi
qd.lo=-qd.lo
end if
Return qd
End Function
'##############################################################################
Sub longmodr(ByRef a As quad, ByRef b As quad, ByRef n As Integer, ByRef rm As quad)
' Extended arithmetic calculation of the 'rounded' modulus:
' a = n.b + rm
' where all quantities are in quadruple-precision, except the Integer
' number of multiples, n. The absolute value of the remainder (rm)
' is not greater than b/2.
' The result is exact. remainder may occupy the same location as either input.
' Programmer: Alan Miller
' Latest revision - 11 September 1986
' Fortran version - 4 December 1996
Dim As quad temp
' Check that b.hi .ne. 0
If (b.hi = zero) Then
Print " *** Error in longmodr - 3rd argument zero ***"
Return
End If
' Calculate n.
temp = longdiv(a , b)
n = nint(CSng(temp.hi))
' Calculate remainder preserving full accuracy.
temp = exactmul2(CDbl(n), b.hi)
rm.hi = a.hi
rm.lo = zero
temp = longsub(rm , temp)
rm.hi = a.lo
rm.lo = zero
temp = longadd(rm , temp)
rm = exactmul2(CDbl(n), b.lo)
rm = longsub(temp , rm)
End Sub 'longmodr
Sub longcst(ByRef a As quad, ByRef b As quad, ByRef sine As Integer,_
ByRef cosine As Integer, ByRef tangent As Integer)
Dim As Integer pos1
Dim As quad d, term, temp, angle, sum1, sum2, sin1
Dim As Integer npi, ipt, i
Dim As Double tol15 = 1.E-15, tol30 = 1.E-30
' Sin(i.pi/40), i = 0(1)20
Static As quad table(0 To 20)
table( 0) = cquad(0.0000000000000000E+00, 0.0000000000000000E+00)
table( 1) = cquad(0.7845909572784494E-01, 0.1464397249532491E-17)
table( 2) = cquad(0.1564344650402309E+00, -.2770509565052586E-16)
table( 3) = cquad(0.2334453638559054E+00, 0.2058612230858154E-16)
table( 4) = cquad(0.3090169943749475E+00, -.8267172724967036E-16)
table( 5) = cquad(0.3826834323650898E+00, -.1005077269646159E-16)
table( 6) = cquad(0.4539904997395468E+00, -.1292033036231312E-16)
table( 7) = cquad(0.5224985647159488E+00, 0.6606794454708078E-16)
table( 8) = cquad(0.5877852522924732E+00, -.1189570533007057E-15)
table( 9) = cquad(0.6494480483301838E+00, -.1134903961116171E-15)
table(10) = cquad(0.7071067811865476E+00, -.4833646656726458E-16)
table(11) = cquad(0.7604059656000310E+00, -.1036987135483477E-15)
table(12) = cquad(0.8090169943749476E+00, -.1381828784809282E-15)
table(13) = cquad(0.8526401643540922E+00, 0.4331886637554353E-16)
table(14) = cquad(0.8910065241883680E+00, -.1474714419679880E-15)
table(15) = cquad(0.9238795325112868E+00, -.9337725537817898E-16)
table(16) = cquad(0.9510565162951536E+00, -.7008780156242836E-16)
table(17) = cquad(0.9723699203976766E+00, 0.4478912629332321E-16)
table(18) = cquad(0.9876883405951378E+00, -.4416018005989794E-16)
table(19) = cquad(0.9969173337331280E+00, 0.1235153006196267E-16)
table(20) = cquad(0.1000000000000000E+01, 0.0000000000000000E+00)
' Reduce angle to range (-pi/2, +pi/2) by subtracting an Integer multiple of pi.
longmodr(a, pi, npi, angle)
' Find nearest multiple of pi/40 to angle.
longmodr(angle, piby40, ipt, d)
' Sum 1 = 1 - d**2/2' + d**4/4' - d**6/6' + ...
' Sum 2 = d - d**3/3' + d**5/5' - d**7/7' + ...
sum1.hi = zero
sum1.lo = zero
sum2.hi = zero
sum2.lo = zero
pos1 = 0
term = d
i = 2
L20: If (Abs(term.hi) > tol15) Then
term = longmul(term , d) ' Use quad. precision
If (i = 2 Or i = 4 Or i = 8) Then
term.hi = term.hi / i
term.lo = term.lo / i
Else
term = div_quad_int(term , i)
End If
If (pos1) Then
sum1 = longadd(sum1 , term)
Else
sum1 = longsub(sum1 , term)
End If
Else
term.hi = term.hi * d.hi / CDbl(i) ' Double prec. adequate
If (pos1) Then
sum1.lo = sum1.lo + term.hi
Else
sum1.lo = sum1.lo - term.hi
End If
End If
' Repeat for sum2
i = i + 1
If (Abs(term.hi) > tol15) Then
term = longmul(term, div_quad_int( d, i)) ' Use quad. precision
If (pos1) Then
sum2 = longadd(sum2 , term)
Else
sum2 = longsub(sum2 , term)
End If
Else
term.hi = term.hi * d.hi / CDbl(i) ' Double prec. adequate
If (pos1) Then
sum2.lo = sum2.lo + term.hi
Else
sum2.lo = sum2.lo - term.hi
End If
End If
i = i + 1
pos1 = Not pos1
If (Abs(term.hi) > tol30) Then GoTo L20
sum1 = quad_add_dp(sum1 , one) ' Now add the 1st terms
sum2 = longadd(sum2 , d) ' for max. accuracy
' Construct sine, cosine or tangent.
' Sine first. Sin(angle + d) = Sin(angle).Cos(d) + Cos(angle).Sin(d)
If (sine Or tangent) Then
If (ipt >= 0) Then
temp = table(ipt)
Else
temp = negate_quad(table( -ipt))
End If
b = longmul(sum1 , temp)
If (ipt >= 0) Then
temp = table( 20-ipt)
Else
temp = table( 20+ipt)
End If
b = longadd(b , longmul(sum2 , temp))
If (npi <> 2*(npi\2)) Then
b = negate_quad(b)
End If
If (tangent) Then
sin1 = b
End If
End If
' Cosine or tangent.
If (cosine Or tangent) Then
If (ipt >= 0) Then
temp = table( ipt)
Else
temp = negate_quad(table( -ipt))
End If
b = longmul(sum2 , temp)
If (ipt >= 0) Then
temp = table( 20-ipt)
Else
temp = table( 20+ipt)
End If
b = longsub(longmul(sum1 , temp) , b)
If (npi <> 2*(npi\2)) Then
b = negate_quad(b)
End If
End If
' Tangent.
If (tangent) Then
' Check that bhi .ne. 0
If (b.hi = 0.d0) Then
Print " *** Infinite tangent - routine longcst ***"
b.hi = 1.0D+308
b.lo = 0.d0
Return
End If
b = longdiv(sin1 , b)
End If
End Sub 'longcst
' Extended accuracy arithmetic sine, cosine & tangent (about 31 decimals).
' Calculates b = sin, cos or tan (a), where all quantities are in
' quadruple-precision, using table look-up and a Taylor series expansion.
' The result may occupy the same locations as the input value.
' Much of the code is common to all three Functions, and this is in a
' Sub longcst.
Function longSin(ByRef a As quad) As quad 'Result(b)
Dim As quad b
Dim As Integer sine, cosine, tangent
' Set logical variables for sine Function.
sine = -1
cosine = 0
tangent = 0
longcst(a, b, sine, cosine, tangent)
Return b
End Function 'longsin
Function longCos(ByRef a As quad) As quad 'Result(b)
Dim As quad b
Dim As Integer sine, cosine, tangent
' Set logical variables for sine Function.
sine = 0
cosine = -1
tangent = 0
longcst(a, b, sine, cosine, tangent)
Return b
End Function 'longcos
Function longTan(ByRef a As quad) As quad 'Result(b)
Dim As quad b
Dim As Integer sine, cosine, tangent
' Set logical variables for sine Function.
sine = 0
cosine = 0
tangent = -1
longcst(a, b, sine, cosine, tangent)
Return b
End Function 'longtan
Function longAsin(ByRef a As quad) As quad 'Result(b)
' Quadratic-precision arc sine (about 31 decimals).
' One Newton-Raphson iteration to solve: f(b) = Sin(b) - a = 0,
' except when a close to -1 or +1.
' The result (b) may occupy the same location as the input values (a).
' Use ACOS when |a| is close to 1.
Dim As quad y, b, c
' Check that -1 <= a.hi <= +1.
If (a.hi < -one Or a.hi > one) Then
Print " *** Argument outside range for longasin ***"
Return b
End If
If (Abs(a.hi) < 0.866) Then
' First approximation is y = Asin(a).
' Quadruple-precision result is y - [Sin(y) - a]/Cos(y).
y.hi = Asin(a.hi)
y.lo = zero
'b = y + (a - Sin(y)) / Cos(y.hi)
b = longadd(y,div_quad_dp(longsub(a,longSin(y)),Cos(y.hi)))
Else
' Calculate Acos(c) where c = Sqr(1 - a^2)
c = longSqr(dp_sub_quad(one , longmul(a,a)))
y.hi = ACos(c.hi)
y.lo = zero
'b = y + (Cos(y) - c) / Sin(y.hi)
b = longadd(y,div_quad_dp(longsub(longCos(y),c),Sin(y.hi)))
If (a.hi < zero) Then b = negate_quad(b)
End If
Return b
End Function 'longasin
Function longAcos(ByRef a As quad) As quad 'Result(b)
' Quadratic-precision arc cosine (about 31 decimals).
' Newton-Raphson iteration to solve: f(b) = Cos(b) - a = 0.
' The result (b) may occupy the same location as the input values (a).
' When |a| is near 1, use formula from p.175 of
' `Software Manual for the Elementary Functions' by W.J. Cody, Jr. &
' W. Waite, Prentice-Hall, 1980.
Dim As quad y, b, c
' Check that -1 <= a.hi <= +1.
If (a.hi < -one Or a.hi > one) Then
Print "*** Argument outside range for longacos ***"
Return b
End If
If (Abs(a.hi) < 0.866) Then
' First approximation is y = Acos(a).
' Quadruple-precision result is y + [Cos(y) - a]/Sin(y).
y.hi = ACos(a.hi)
y.lo = zero
'b = y + (Cos(y) - a) / Sin(y.hi)
b = longadd(y, div_quad_dp(longsub(longCos(y),a),Sin(y.hi)))
Else
' Calculate 2.Asin(c) where c = Sqr([1 - |a|]/2)
'c = Sqr((one - Abs(a))/2)
c = longsqr(div_quad_int(dp_sub_quad(one, qabs(a)),2))
y.hi = Asin(c.hi)
y.lo = zero
'b = (y - (Sin(y) - c) / Cos(y.hi))*2
b = mult_quad_int(longsub(y,div_quad_dp(longsub(longSin(y),c),Cos(y.hi))),2)
If (a.hi < zero) Then b = longsub(pi , b)
End If
Return b
End Function 'longacos
Function longAtn(ByRef a As quad) As quad 'Result(b)
' Quadratic-precision arc tangent (about 31 decimals).
' Newton-Raphson iteration to solve: f(b) = Tan(b) - a = 0.
' The result (b) may occupy the same location as the input values (a).
Dim As quad b, y
Dim As Double t
' First approximation is y = Atn(a).
' Quadruple-precision result is y - [Tan(y) - a] * Cos(y)**2.
y.hi = Atn(a.hi)
y.lo = zero
'b = y - (Tan(y) - a) * (Cos(y.hi))**2
t = Cos(y.hi)
t = t*t
b = longsub(y,mult_quad_dp(longsub(longTan(y),a),t))
Return b
End Function 'longatan
Function qAtan2(ByRef y As quad, ByRef x As quad) As quad 'Result(b)
' Quadratic-precision arc tangent (about 31 decimals).
' As for arc tangent (y/x) except that the result is in the range
' -pi < ATAN2 <= pi.
' The signs of x and y determine the quadrant.
Dim As quad b, z
Dim As Double t
' First approximation is z = Atan2(y, x).
' Quadruple-precision result is z - [Tan(z) - (y/x)] * Cos(z)**2.
z.hi = Atan2(y.hi, x.hi)
z.lo = zero
If (x.hi = zero) Then
b = z
Else
t = Cos(z.hi)
t = t*t
'b = z - (Tan(z) - y/x) * (Cos(z.hi))**2
b = longsub(z, mult_quad_dp(longsub(longTan(z),longdiv(y, x)),t))
End If
Return b
End Function 'qatan2
Function quad_sum(a() As quad) As quad 'Result(s)
' Quadruple-precision SUM
Dim As Integer i
Dim As quad s
's = cquad(zero, zero)
For i=LBound(a) To UBound(a)
s = longadd(s , a(i))
Next
Return s
End Function 'quad_sum
Function quad_dot_product(a() As quad, b() As quad) As quad 'Result(ab)
' Quadruple-precision DOT_PRODUCT
Dim As Integer i, n
Dim As quad ab
'ab = cquad(zero, zero)
n = UBound(a)
If (n <> UBound(b)) Or (LBound(a)<>LBound(b)) Then
Print "** Error invoking DOT_PRODUCT - dIfferent argument sizes **"
Print " Size of 1st argument = "; n, _
" Size of 2nd argument = "; UBound(b)
Return ab
End If
For i = LBound(a) To n
ab = longadd(ab, longmul( a(i),b(i)))
Next
Return ab
End Function 'quad_dot_product
Function quad_int(ByRef a As quad) As Integer
Dim As Integer i
i=Int(a.hi)
Return i
End Function
Function Sqr_(ByVal x As Double) As Double
Return Sqr(x)
End Function
#Undef Sqr
Function Sqr OverLoad(ByRef x As Double) As Double
Return Sqr_(x)
End Function
Function Sqr (ByRef x As quad) As quad
Return longSqr(x)
End Function
Function Exp_(ByVal x As Double) As Double
Return Exp(x)
End Function
#Undef Exp
Function Exp OverLoad(ByRef x As Double) As Double
Return Exp_(x)
End Function
Function Exp (ByRef x As quad) As quad
Return longExp(x)
End Function
Function Log_(ByVal x As Double) As Double
Return Log(x)
End Function
#Undef Log
Function Log OverLoad(ByRef x As Double) As Double
Return Log_(x)
End Function
Function Log (ByRef x As quad) As quad
Return longLog(x)
End Function
Function Sin_(ByVal x As Double) As Double
Return Sin(x)
End Function
#Undef Sin
Function Sin OverLoad(ByRef x As Double) As Double
Return Sin_(x)
End Function
Function Sin (ByRef x As quad) As quad
Return longSin(x)
End Function
Function Cos_(ByVal x As Double) As Double
Return Cos(x)
End Function
#Undef Cos
Function Cos OverLoad(ByRef x As Double) As Double
Return Cos_(x)
End Function
Function Cos (ByRef x As quad) As quad
Return longCos(x)
End Function
Function Tan_(ByVal x As Double) As Double
Return Tan(x)
End Function
#Undef Tan
Function Tan OverLoad(ByRef x As Double) As Double
Return Tan_(x)
End Function
Function Tan (ByRef x As quad) As quad
Return longTan(x)
End Function
Function Asin_(ByVal x As Double) As Double
Return Asin(x)
End Function
#Undef Asin
Function Asin OverLoad(ByRef x As Double) As Double
Return Asin_(x)
End Function
Function Asin (ByRef x As quad) As quad
Return longAsin(x)
End Function
Function Acos_(ByVal x As Double) As Double
Return ACos(x)
End Function
#Undef ACos
Function ACos OverLoad(ByRef x As Double) As Double
Return Acos_(x)
End Function
Function ACos (ByRef x As quad) As quad
Return longAcos(x)
End Function
Function Atn_(ByVal x As Double) As Double
Return Atn(x)
End Function
#Undef Atn
Function Atn OverLoad(ByRef x As Double) As Double
Return Atn_(x)
End Function
Function Atn (ByRef x As quad) As quad
Return longAtn(x)
End Function
Function Atan2_(ByVal x As Double, ByVal y As Double) As Double
Return Atan2(x,y)
End Function
#Undef Atan2
Function Atan2 OverLoad(ByRef x As Double, ByVal y As Double) As Double
Return Atan2_(x,y)
End Function
Function Atan2 (ByRef x As quad, ByRef y As quad) As quad
Return qAtan2(x,y)
End Function
Function Abs_(ByVal x As Double) As Double
Return Abs(x)
End Function
#Undef Abs
Function Abs OverLoad(ByRef x As Double) As Double
Return Abs_(x)
End Function
Function Abs (ByRef x As quad) As quad
Return qabs(x)
End Function
'Function Val_(Byval x As String) As Double
' Return Val(x)
'End Function
'#undef Val
'Function Val Overload(Byref x As String) As Double
' Return Val_(x)
'End Function
'
'Function Val Overload(Byref x As String) As quad
' Return string_quad(x)
'End Function
'Declare Function cquad Overload ( Byref lhs As quad ) As quad
Declare Function cquad ( ByRef lhs As Integer ) As quad
Declare Function cquad ( ByRef lhs As Long ) As quad
Declare Function cquad ( ByRef lhs As LongInt ) As quad
Declare Function cquad ( ByRef lhs As UInteger ) As quad
Declare Function cquad ( ByRef lhs As ULong ) As quad
Declare Function cquad ( ByRef lhs As ULongInt ) As quad
Declare Function cquad ( ByRef lhs As Single ) As quad
Declare Function cquad ( ByRef lhs As Double ) As quad
Declare Function cquad ( ByRef lhs As String ) As quad
Function cquad ( ByRef lhs As quad ) As quad
Return lhs
End Function
Function cquad ( ByRef lhs As Integer ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As Long ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As LongInt ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As UInteger ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As ULong ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As ULongInt ) As quad
Dim As quad retval
retval.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As Single ) As quad
Dim As quad retval
retval = string_quad ( str(lhs) )
Return retval
End Function
Function cquad ( ByRef lhs As Double ) As quad
Dim As quad retval
retval = string_quad ( str(lhs) )
Return retval
End Function
Function cquad ( ByRef lhs As String ) As quad
Dim As quad retval
retval = string_quad ( lhs )
Return retval
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Operator + ( ByRef lhs As quad, ByRef rhs As quad ) As quad
Dim As quad retval
retval = longadd ( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As Integer ) As quad
Dim As quad retval
retval = quad_add_int( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As Integer, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_add_quad ( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As Long ) As quad
Dim As quad retval
retval = quad_add_int( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As Long, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_add_quad(lhs , rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As LongInt ) As quad
Dim As quad retval
retval = quad_add_dp(lhs, CDbl(rhs) )
Return retval
End Operator
Operator + ( ByRef lhs As LongInt, ByRef rhs As quad ) As quad
Dim As quad retval
retval = dp_add_quad(CDbl(lhs), rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As UInteger ) As quad
Dim As quad retval
retval = quad_add_int( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As UInteger, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_add_quad( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As ULong ) As quad
Dim As quad retval
retval = quad_add_int( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As ULong, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_add_quad( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As Single ) As quad
Dim As quad retval
retval = quad_add_Real(lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As Single, ByRef rhs As quad ) As quad
Dim As quad retval
retval = Real_add_quad( lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As quad, ByRef rhs As Double ) As quad
Dim As quad retval
retval = quad_add_dp(lhs, rhs )
Return retval
End Operator
Operator + ( ByRef lhs As Double, ByRef rhs As quad ) As quad
Dim As quad retval
retval = dp_add_quad( lhs, rhs )
Return retval
End Operator
Operator quad.+= ( ByRef rhs As quad )
Dim As quad retval
this = longadd(this, rhs )
End Operator
Operator quad.+= ( ByRef rhs As Double )
Dim As quad retval
this = quad_add_dp(this, rhs )
End Operator
Operator quad.+= ( ByRef rhs As Integer )
Dim As quad retval
this = quad_add_int(this, rhs )
End Operator
Operator quad.+= ( ByRef rhs As String )
Dim As quad retval
retval = string_quad( rhs )
this = longadd(this, retval )
End Operator
'-------------------------------------------------------------
Operator - ( ByRef lhs As quad, ByRef rhs As quad ) As quad
Dim As quad retval
retval = longsub(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad, ByRef rhs As Integer ) As quad
Dim As quad retval
retval = quad_sub_int(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As Integer, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_sub_quad(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad, ByRef rhs As Long ) As quad
Dim As quad retval
retval = quad_sub_int(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As Long, ByRef rhs As quad ) As quad
Dim As quad retval
retval = int_sub_quad(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad, ByRef rhs As LongInt ) As quad
Dim As quad retval
retval = quad_sub_dp(lhs, CDbl(rhs) )
Return retval
End Operator
Operator - ( ByRef lhs As LongInt, ByRef rhs As quad ) As quad
Dim As quad retval
retval = dp_sub_quad(CDbl(lhs), rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad, ByRef rhs As Single ) As quad
Dim As quad retval
retval = quad_sub_Real(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As Single, ByRef rhs As quad ) As quad
Dim As quad retval
retval = Real_sub_quad(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad, ByRef rhs As Double ) As quad
Dim As quad retval
retval = quad_sub_dp(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As Double, ByRef rhs As quad ) As quad
Dim As quad retval
retval = dp_sub_quad(lhs, rhs )
Return retval
End Operator
Operator - ( ByRef lhs As quad ) As quad
Dim As quad retval
retval = negate_quad(lhs )
Return retval
End Operator
Operator quad.-= ( ByRef rhs As quad )
Dim As quad retval
this = longsub(this, rhs )
End Operator
Operator quad.-= ( ByRef rhs As Double )
Dim As quad retval
this = quad_sub_dp(this, rhs )
End Operator
Operator quad.-= ( ByRef rhs As Integer )
Dim As quad retval
this = quad_sub_int(this, rhs )
End Operator
Operator quad.-= ( ByRef rhs As String )
Dim As quad retval
retval = string_quad( rhs )
this = longsub(this, retval )
End Operator