Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

quad_3.bi

Uploader:RedakteurVolta
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