src/ness/nesobj_mat.f

Fortran project RESTRAX, source module src/ness/nesobj_mat.f.

Source module last modified on Wed, 13 Jul 2005, 16:20;
HTML image of Fortran source automatically generated by for2html on Mon, 29 May 2006, 15:06.


#-------------------------------------------------------------------
        logical*4 FUNCTION QUADREQ(a,b,c,x)
#
#-------------------------------------------------------------------
      parameter (eps=1e-10)
      real*8 a,b,c,x,x1,x2,det

        if (a.eq.0) then          
          if (abs(b).lt.eps) then 
             goto 20
          else
             x=-c/b
             goto 30
          endif
        else          
          det=b**2-4*a*c
          if  (det.eq.0.) then
             x=-b/2./a
             goto 30
          else if (det.lt.0.) then
             goto 20
          else
             det=sqrt(det) 
             x1=(-b+det)/2./a
             x2=(-b-det)/2./a
             if (x1.gt.eps.and.x2.gt.eps) then
                 x=min(x1,x2)
             else if (x1.gt.eps) then
                 x=x1
             else if (x2.gt.eps) then
                 x=x2
             else 
                 goto 20
             endif
             goto 30
          endif
        endif 
                  
20      QUADREQ=.false.
        x=1.d30
        return

30      if (x.gt.eps) then
           QUADREQ=.true.
        else
            goto 20
        endif
        return  

      end