fb:porticula NoPaste
quad_3.bi
Uploader: | Volta |
Datum/Zeit: | 30.09.2010 20:37:06 |
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 = cquad(10.0, zero)
Dim As Integer j, s, d, e, ep, ex, es, i, f, fp, fln
Dim As String c, f1, f2, f3, 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
fln=Len(f1)
If Len(f1)>30 Then
f1=Mid(f1,1,30)
EndIf
While Len(f1)<30
f1=f1+"0"
Wend
f2=Str(Abs(ex))
f2=String(4-Len(f2),"0")+f2
If ex<0 Then
f2="E-"+f2
Else
f2="E+"+f2
EndIf
f2=Left(f1,15)
f3=Right(f1,15)
qd.hi=Val(f2)
qd.lo=0
qd=mult_quad_dp(qd, 1000000000000000)
qd=quad_add_dp(qd, Val(f3))
pt = quad_pow_int(pt, 29-ex)
qd=longdiv(qd,pt)
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.hi = CDbl(lhs)
retval.lo = zero
Return retval
End Function
Function cquad ( ByRef lhs As Double ) As quad
Dim As quad retval
retval.hi = lhs
retval.lo = zero
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