Program s22bffe

!     S22BFF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, s22bff, x02bhf, x02blf, x07caf, x07cbf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: adr, ani, bdr, bni, cdr, cni, delta, &
                                          frf, scale, x
      Integer                          :: ifail, k, scf
      Logical                          :: finite_solutions
!     .. Local Arrays ..
      Real (Kind=nag_wp)               :: frfv(2)
      Integer                          :: exmode(3), scfv(2)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'S22BFF Example Program Results'

!     Get current exception mode
      Call x07caf(exmode)
!     Disable exceptions
      Call x07cbf((/0,0,0/))

      finite_solutions = .True.

      ani = -10.0_nag_wp
      bni = 2.0_nag_wp
      cni = -5.0E0_nag_wp
      delta = 1.0E-4_nag_wp
      adr = delta
      bdr = -delta
      cdr = delta
      x = 0.45_nag_wp

      Write (nout,99999) 'a', 'b', 'c', 'x', 'frf', 'scf', ' 2F1(a,b;c;x)'

      Do k = 1, 2

        ifail = 1
        Call s22bff(ani,adr,bni,bdr,cni,cdr,x,frf,scf,ifail)
        Select Case (ifail)
        Case (0,1,2,3)
!         A finite result has been returned.
          If (scf<x02blf()) Then
            scale = frf*2.0E0_nag_wp**scf
            Write (nout,99998) ani + adr, bni + bdr, cni + cdr, x, frf, scf,   &
              scale
          Else
            Write (nout,99997) ani + adr, bni + bdr, cni + cdr, x, frf, scf,   &
              'Not representable'
          End If
        Case (4)
!         The result is analytically infinite.
          finite_solutions = .False.
          If (frf>=0.0E0_nag_wp) Then
            Write (nout,99993) ani + adr, bni + bdr, cni + cdr, x, 'Inf', scf, &
              'Inf'
          Else
            Write (nout,99993) ani + adr, bni + bdr, cni + cdr, x, '-Inf',     &
              scf, '-Inf'
          End If
        Case (5,6)
!         The final result has overflowed.
          finite_solutions = .False.
          If (frf>=0.0E0_nag_wp) Then
            Write (nout,99992) ani + adr, bni + bdr, cni + cdr, x, frf,        &
              'IMAX', '>2**IMAX'
          Else
            Write (nout,99992) ani + adr, bni + bdr, cni + cdr, x, frf,        &
              'IMAX', '<-2**IMAX'
          End If
        Case (9)
!         An internal calculation resulted in a non-finite, non-infinite
!         result.
          finite_solutions = .False.
          Write (nout,99993) ani + adr, bni + bdr, cni + cdr, x, 'NaN', scf,   &
            'NaN'
        Case Default
!         An input error has been detected.
          Write (nout,99996) ani + adr, bni + bdr, cni + cdr, x, 'FAILED'
          Go To 100
        End Select

        frfv(k) = frf
        scfv(k) = scf

        adr = -adr
        bdr = -bdr
        cdr = -cdr

      End Do

      If (finite_solutions) Then
!       Calculate the product M1*M2
        frf = frfv(1)*frfv(2)
        scf = scfv(1) + scfv(2)
        Write (nout,*)
        If (scf<x02blf()) Then
          scale = frf*real(x02bhf(),kind=nag_wp)**scf
          Write (nout,99995) 'Solution product', frf, scf, scale
        Else
          Write (nout,99994) 'Solution product', frf, scf, 'Not representable'
        End If

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

100   Continue
!     Restore exception mode.
      Call x07cbf(exmode)

99999 Format (/,1X,4(A10,1X),A13,1X,A6,1X,A13)
99998 Format (1X,4(F10.4,1X),Es13.5,1X,I6,1X,Es13.5)
99997 Format (1X,4(F10.4,1X),Es13.5,1X,I6,1X,A17)
99996 Format (1X,4(F10.4,1X),20X,A17)
99995 Format (1X,A16,17X,Es13.5,1X,I6,1X,Es13.5)
99994 Format (1X,A16,17X,Es13.5,1X,I6,1X,A17)
99993 Format (1X,4(F10.4,1X),A13,1X,I6,1X,A13)
99992 Format (1X,4(F10.4,1X),Es13.5,1X,A6,1X,A13)

    End Program s22bffe