Program s22bbfe

!     S22BBF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, s22bbf, x02bhf, x02blf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: ai, ar, bi, br, delta, frm, scale, x
      Integer                          :: ifail, k, scm
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: frmv(2)
      Integer                          :: scmv(2)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'S22BBF Example Program Results'

      ai = -10.0_nag_wp
      bi = 30.0_nag_wp
      delta = 1.0E-4_nag_wp
      ar = delta
      br = -delta
      x = 25.0_nag_wp

      Write (nout,99999) 'a', 'b', 'x', 'frm', 'scm', 'M(a,b,x)'

      Do k = 1, 2
        If (k==2) Then
          ar = -ar
          br = -br
        End If

        ifail = -1
        Call s22bbf(ai,ar,bi,br,x,frm,scm,ifail)
        If (ifail==2 .Or. ifail>3) Then
!         Either the result has overflowed, no accuracy may be assumed,
!          or an input error has been detected.
          Write (nout,99996) ai + ar, bi + br, x, 'FAILED'
          Go To 100
        Else If (scm<x02blf()) Then
          scale = frm*real(x02bhf(),kind=nag_wp)**scm
          Write (nout,99998) ai + ar, bi + br, x, frm, scm, scale
        Else
          Write (nout,99997) ai + ar, bi + br, x, frm, scm,                    &
            'Not representable'
        End If
        frmv(k) = frm
        scmv(k) = scm
      End Do

!     Calculate the product M1*M2
      frm = frmv(1)*frmv(2)
      scm = scmv(1) + scmv(2)
      Write (nout,*)
      If (scm<x02blf()) Then
        scale = frm*real(x02bhf(),kind=nag_wp)**scm
        Write (nout,99995) 'Solution product', frm, scm, scale
      Else
        Write (nout,99994) 'Solution product', frm, scm, 'Not representable'
      End If

!     Calculate the ratio M1/M2
      If (frmv(2)/=0.0_nag_wp) Then
        frm = frmv(1)/frmv(2)
        scm = scmv(1) - scmv(2)
        Write (nout,*)
        If (scm<x02blf()) Then
          scale = frm*real(x02bhf(),kind=nag_wp)**scm
          Write (nout,99995) 'Solution ratio  ', frm, scm, scale
        Else
          Write (nout,99994) 'Solution ratio  ', frm, scm, 'Not representable'
        End If
      End If

100   Continue

99999 Format (/,1X,3(A10,1X),A12,1X,A6,1X,A12)
99998 Format (1X,3(F10.4,1X),Es12.4,1X,I6,1X,Es12.4)
99997 Format (1X,3(F10.4,1X),Es12.4,1X,I6,1X,A17)
99996 Format (1X,3(F10.4,1X),20X,A17)
99995 Format (1X,A16,17X,Es12.4,1X,I6,1X,Es12.4)
99994 Format (1X,A16,17X,Es12.4,1X,I6,1X,A17)
    End Program s22bbfe