!-----------4 parameters---------------------------------
! Non-rectangular hyperbola function and derivatives
! y=a+b(x-sqrt(c+dx+x2)) or y=(ax+b-sqrt((ax+b)^2-4abcx))/2c-d
!
      subroutine fnonrecthypb(a,b,c,d,x,y,iwrong)
      implicit none
      integer iwrong
      double precision a,b,c,d,x,y,p
      iwrong=0
      goto 10
!----------------------------------------
!a=alpha, b=Amax, c=theta, d=rd
      p=(a*x+b)*(a*x+b)-4.0d0*a*b*c*x
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      y=(a*x+b-dsqrt(p))/(2.0d0*c)-d
      return
!----------------------------------------
10    p=c+d*x+x*x
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      y=a+b*(x-dsqrt(p))
      return
      end
      
      subroutine indices_fnonrecthypb(a,b,c,d,root,
     &   der_root,fmax,iwrong)
      implicit none
      double precision a,b,c,d,root,der_root,fmax,p
      integer iwrong
      iwrong=0
      goto 10
!---------------------------
      root=(c*d*d-b*d)/(a*d-a*b)
      fmax=b
      p=(a*root+b)*(a*root+b)-4.0d0*a*b*c*root
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      der_root=(a-a*(a*root+b-2.0d0*b*c)/dsqrt(p))
     &       /(2.0d0*c)
      return
!------------------------------
10    root=(b*b*c-a*a)/(2.0d0*a*b-b*b*d)
      fmax=a-0.5d0*b*d
      p=root*root+d*root+c
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      der_root=b*(1.0d0-(2.0d0*root+d)/
     &            (2.0d0*dsqrt(p)))
      return
      end
      
      subroutine der_fnonrecthypb(a,b,c,d,x,da,db,dc,dd,dx,
     &                            iwrong)
      implicit none
      integer iwrong
      double precision a,b,c,d,x,da,db,dc,dd,dx
      double precision p
      iwrong=0
      goto 10
!-----------------------------------------
      p=(a*x+b)*(a*x+b)-4.0d0*a*b*c*x
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      p=dsqrt(p)
      da=(x-x*(a*x+b-2.0d0*b*c)/p)/(2.0d0*c)
      db=(1.0d0-(a*x+b-2.0d0*a*c*x)/p)/(2.0d0*c)
      dd=-1.0d0
      dc=a*b*x/(c*p)-(a*x+b-p)/(2.0d0*c*c)
      dx=(a-a*(a*x+b-2.0d0*b*c)/p)/(2.0d0*c)
      return
!------------------------------------------
10    p=c+d*x+x*x
      if(p.lt.0.0d0)then
        iwrong=1
        return
      endif
      p=dsqrt(p)
      da=1.0d0
      db=x-p
      dc=-b/(2.0d0*p)
      dd=dc*x
      dx=b*(1.0d0-(d+2.0d0*x)/(2.0d0*p))
      return
      end

!-------3 parameters----------------------
      subroutine recthypb(a,b,c,x,y)
      implicit none
      double precision a,b,c,x,y
      y=(a*x+b)/(x+c)
      return
      end

      subroutine indices_frecthypb(a,b,c,root,
     &   der_root,fmax)
      implicit none
      double precision a,b,c,root,
     &   der_root,fmax
      root=-b/a
      der_root=a*a/(a*c-b)
      fmax=a
      return
      end

      subroutine der_recthypb(a,b,c,x,da,db,dc,dx)
      implicit none
      double precision a,b,c,x,da,db,dc,dx
      da=x/(x+c)
      db=1.0d0/(x+c)
      dc=-(a*x+b)/((x+c)*(x+c))
      dx=a/(x+c)-(a*x+b)/((x+c)*(x+c))
      return
      end
