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