#pragma -xO
C Source: netlib.org/slatec
C SLATEC code is in the public domain.

*DECK TESTI
            program testi
C***BEGIN PROLOGUE  TESTI
C***PURPOSE  Driver for testing SLATEC subprogram
C                  fullerton intrinsics.
C***LIBRARY   FNLIB
C***CATEGORY  Z
C***TYPE            all (testi-a)
C***KEYWORDS  FULLERTON INTRINSIC FUNCTIONS, QUICK CHECK DRIVER
C***AUTHOR  SLATEC Common Mathematical Library Committee
C***DESCRIPTION
C
C *Usage:
C     One input data record is required
C               read (unit=lin, fmt='(i1)') kprint
C
C *Arguments:
C     KPRINT = 0  Quick checks - No printing.
C                       driver       - short pass or fail message printed.
C                    1  quick checks - no message printed for passed tests,
C                                      short message printed for failed tests.
C                       driver       - short pass or fail message printed.
C                    2  quick checks - print short message for passed tests,
C                                      fuller information for failed tests.
C                       driver       - pass or fail message printed.
C                    3  quick checks - print complete quick check results.
C                       driver       - pass or fail message printed.
C
C *Description:
C     Driver for testing SLATEC subprogram
C
C***REFERENCES  Fong, Kirby W., Jefferson, Thomas H., Suyehiro,
C                       tokihiko, walton, lee, guidelines to the slatec common
C                       mathematical library, march 21, 1989.
C***ROUTINES CALLED  I1MACH, QCINTC, QCINTD, QCINTS, XERMAX, XSETF,
C                          xsetun
C***REVISION HISTORY  (YYMMDD)
C   900709  DATE WRITTEN
C***END PROLOGUE  TESTI
C     .. Local Scalars ..
            integer ipass, kprint, lin, lun, nfail
C     .. External Functions ..
            integer i1mach
            external i1mach
C     .. External Subroutines ..
            external qcintc, qcintd, qcints, xermax, xsetf, xsetun
C***FIRST EXECUTABLE STATEMENT  TESTI
            lun = i1mach(2)
C     LIN = I1MACH(1)
            lin = 2
            nfail = 0
C
C     Read KPRINT parameter
C
            read (lin, '(i1)') kprint
            call xsetun (lun)
            call xermax (1000)
            if (kprint .le. 1) then
               call xsetf (0)
            else
               kprint = 2
               call xsetf (1)
            endif
C
C     Test single precision Fullerton intrinsics.
C
            call qcints (lun, kprint, ipass)
            if (ipass .eq. 0) nfail = nfail + 1
C
C     Test double precision Fullerton intrinsics.
C
            call qcintd (lun, kprint, ipass)
            if (ipass .eq. 0) nfail = nfail + 1
C
C     Test complex Fullerton intrinsics.
C
            call qcintc (lun, kprint, ipass)
            if (ipass .eq. 0) nfail = nfail + 1
C
C     Write PASS or FAIL message
C
            if (nfail .eq. 0) then
               write (unit=lun, fmt=9000)
            else
               write (unit=lun, fmt=9010) nfail
            endif
            stop
 9000 FORMAT (/' --------------TESTI PASSED ALL TESTS----------------')
 9010 FORMAT (/' ************* WARNING -- ', I5,
     1              ' test(s) failed in program testi *************')
            end
*DECK QCINTC
            subroutine qcintc (lun, kprint, ipass)
C***BEGIN PROLOGUE  QCINTC
C***PURPOSE  Quick check for the complex Fullerton elementary
C                  intrinsic functions.
C***LIBRARY   FNLIB
C***CATEGORY  C
C***TYPE            complex (qcints-s, qcintd-d, qcintc-c)
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Boland, W. Robert, (LANL)
C                 rivera, shawn m., (lanl)
C***DESCRIPTION
C
C   This subroutine does a quick check for the complex
C   Fullerton elementary intrinsic functions.
C
C   Parameter list-
C
C   LUN            input integer value to designate the external device unit
C                  for message output
C   KPRINT   input INTEGER value to specify amount of printing to be
C                  done by quick check
C   IPASS    output INTEGER value indicating whether tests passed or
C                  failed
C
C***ROUTINES CALLED  CABS, CCOS, CEXP, CLOG, CSIN, CSQRT, R1MACH, SQRT
C***REVISION HISTORY  (YYMMDD)
C   900717  DATE WRITTEN
C***END PROLOGUE  QCINTC
C     .. Scalar Arguments ..
            integer ipass, kprint, lun
C     .. Local Scalars ..
            real errtol
            integer i
C     .. Local Arrays ..
            complex c(20), w(20)
C     .. External Functions ..
            complex ccos, cexp, clog, csin, csqrt
            real cabs, r1mach, sqrt
C     EXTERNAL CCOS, CEXP, CLOG, CSIN, CSQRT, CABS, R1MACH, SQRT
C     .. Intrinsic Functions ..
            intrinsic cmplx
C
C     Complex values through different calculations are stored in C(*)
C
C     .. Data statements ..
            data c( 1) /(  1.0000000000000, 0.0000000000000) /
            data c( 2) /(  89.00280929194, .0078649202825041) /
            data c( 3) /(  30.00001041666, .024999991319455) /
            data c( 4) /(  6324555.320337, .0000001897366596101) /
            data c( 5) /( -0.8414709848079, 0.0000000000000) /
            data c( 6) /(  27.23982534694, 1.930412376268) /
            data c( 7) /(  0.000000000000000, 1.175201193644) /
            data c( 8) /(  1.127805246806, 1.868618519183) /
            data c( 9) /(  0.5403023058681, 0.0000000000000) /
            data c(10) /(  23.96522893293, 13.0834832507) /
            data c(11) /(  1.543080634815, 0.00000000000000) /
            data c(12) /(  2.064433656761, -1.020830949598) /
            data c(13) /( -2.929427471521, -3.391753471626) /
            data c(14) /( -0.7373937155412, 0.6754631805511) /
            data c(15) /(  .1699671429002, .9854497299884) /
            data c(16) /(  0.7055457557766, 9.949196994152) /
            data c(17) /(  3.738352258649, 0.3119690755436) /
            data c(18) /(  4.605747852161, .033986907746255) /
            data c(19) /(  2.313710397461, 0.1488899476095) /
            data c(20) /(  6.907755278982, 0.00000000000000) /
C
C***FIRST EXECUTABLE STATEMENT  QCINTC
C
            if (kprint .ge. 2) write (unit=lun, fmt=9000)
C
C     Exercise routines in Category C2.
C
            w( 1) = csqrt(cmplx(1.0, 0.0))
            w( 2) = csqrt(cmplx(7921.5, 1.4))
            w( 3) = csqrt(cmplx(900.0, 1.5))
            w( 4) = csqrt(cmplx(0.4e+14, 2.4))
C
C     Exercise routines in Category C4A.
C
            w( 5) = csin(cmplx(-1.0, 0.0))
            w( 6) = csin(cmplx(1.5, 4.0))
            w( 7) = csin(cmplx(0.0, 1.0))
            w( 8) = csin(cmplx(0.5, 1.5))
            w( 9) = ccos(cmplx(-1.0, 0.0))
            w(10) = ccos(cmplx(-0.5, 4.0))
            w(11) = ccos(cmplx(0.0, 1.0))
            w(12) = ccos(cmplx(0.5, 1.5))
C
C     Exercise routines in Category C4B.
C
            w(13) = cexp(cmplx(1.5, 4.0))
            w(14) = cexp(cmplx(0.0, 2.4))
            w(15) = cexp(cmplx(0.0, 1.4))
            w(16) = cexp(cmplx(2.3, 1.5))
            w(17) = clog(cmplx(40.0, 12.9))
            w(18) = clog(cmplx(100.0, 3.4))
            w(19) = clog(cmplx(10.0, 1.5))
            w(20) = clog(cmplx(1000.0, 0.0))
C
C     Check for possible errors.
C
            ipass = 1
            errtol = sqrt(r1mach(4))
            do 10 i = 1,20
              if (cabs(c(i)-w(i)) .ge. errtol*cabs(c(i))+errtol) then
                ipass = 0
                if (kprint .ge. 2) write (unit=lun, fmt=9020) i, w(i), c(i)
              endif
   10 CONTINUE
            if (ipass.ne.0 .and. kprint.ge.2) write (unit=lun, fmt=9010)
            return
 9000 FORMAT (// ' Test of complex Fullerton intrinsic routines')
 9010 FORMAT (' Complex Fullerton intrinsic function routines o.k.')
 9020 FORMAT (' For I  = ', I3, '  test fails with  ', /
     +              ' computed result = (', 1p, e22.14, ', ', e22.14,'  ) '/
     +              ' and true result = (', e22.14, ', ', e22.14, '  )')
            end
*DECK QCINTD
            subroutine qcintd (lun, kprint, ipass)
C***BEGIN PROLOGUE  QCINTD
C***PURPOSE  Quick check for the double precision Fullerton
C                  elementary intrinsic functions.
C***LIBRARY   FNLIB
C***CATEGORY  C
C***TYPE            double precision (qcints-s, qcintd-d, qcintc-c)
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Boland, W. Robert, (LANL)
C                 rivera, shawn m., (lanl)
C***DESCRIPTION
C
C   This subroutine does a quick check for the double precision
C   Fullerton intrinsic functions.
C
C   Parameter list-
C
C   LUN            input integer value to designate the external device unit
C                  for message output
C   KPRINT   input INTEGER value to specify amount of printing to be
C                  done by quick check
C   IPASS    output INTEGER value indicating whether tests passed or
C                  failed
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  D1MACH, DACOS, DASIN, DATAN, DATAN2, DCOS, DCOSH,
C                          dexp, dint, dlog, dlog10, dsin, dsinh, dsqrt, dtan,
C                          dtanh
C***REVISION HISTORY  (YYMMDD)
C   900717  DATE WRITTEN
C***END PROLOGUE  QCINTD
C     .. Scalar Arguments ..
            integer ipass, kprint, lun
C     .. Local Scalars ..
            double precision errtol
            integer i
C     .. Local Arrays ..
            double precision v(60), y(60)
C     .. External Functions ..
            double precision d1mach, dacos, dasin, datan, datan2, dcos, dcosh,
     +                       dexp, dint, dlog, dlog10, dsin, dsinh, dsqrt,
     +                       dtan, dtanh
C     EXTERNAL D1MACH, DACOS, DASIN, DATAN, DATAN2, DCOS, DCOSH, DEXP,
C    +                       dint, dlog, dlog10, dsin, dsinh, dsqrt, dtan,
C    +                       dtanh
C     .. Intrinsic Functions ..
            intrinsic abs
C
C     Correct values through different calculations are stored in V(*)
C
C     .. Data statements ..
            data v( 1) /  10.0d0 /
            data v( 2) /  79.0d0 /
            data v( 3) /  900.0d0 /
            data v( 4) /  4.0d0 /
            data v( 5) /  1.0d0 /
            data v( 6) /  89.0d0 /
            data v( 7) /  30.0d0 /
            data v( 8) /  6.32455532033675866399778708d06 /
            data v( 9) /  3.1415926535897932846264338d0 /
            data v(10) /  2.09439510239319549230842892d0 /
            data v(11) /  1.57079632679489661923132169d0 /
            data v(12) /  1.04719755119659774615421446d0 /
            data v(13) / -1.57079632679489661923132169d0 /
            data v(14) / -0.52359877559829887307710723d0 /
            data v(15) /  0.0d0 /
            data v(16) /  0.52359877559829887307710723d0 /
            data v(17) /  -0.785398163397448309615660845d0 /
            data v(18) / -0.463647609000806116214256231d0 /
            data v(19) /  0.0d0 /
            data v(20) /  0.463647609000806116214256231d0 /
            data v(21) / -0.58800260354756755124561108d0 /
            data v(22) / -0.463647609000806116214256231d0 /
            data v(23) /  2.034443935795702707025611744029d0 /
            data v(24) /  2.158798930342464394982471276307d0 /
            data v(25) /  0.540302305868139717400936607d0 /
            data v(26) /  0.877582561890372716116281582d0 /
            data v(27) /  1.0d0 /
            data v(28) /  0. 877582561890372716116281582d0 /
            data v(29) / -0.841470984807896506652502321d0 /
            data v(30) / -0.479425538604203000273287935d0 /
            data v(31) /  0.0d0 /
            data v(32) /  0.479425538604203000273287935d0 /
            data v(33) /  -1.55740772465490223050697485d0 /
            data v(34) / -0.546302489843790513255179465d0 /
            data v(35) /  0.0d0 /
            data v(36) /  0.546302489843790513255179465d0 /
            data v(37) /  2.30258509299404568401799145d0 /
            data v(38) /  2.99573227355399099343522357d0 /
            data v(39) /  3.40119738166215537541323669d0 /
            data v(40) /  3.68887945411393630285245569d0 /
            data v(41) /  1.0d0 /
            data v(42) /  1.30102999566398119521373889d0 /
            data v(43) /  1.4771212547196624372950279d0 /
            data v(44) /  1.60205999132796239042747778d0 /
            data v(45) /  1.00000100530050531421637777d0 /
            data v(46) /  0.999843012323855043126609044d0 /
            data v(47) /  1.00003876575137232151808428d0 /
            data v(48) /  0.992002154326025434343372944d0 /
            data v(49) /  1.54308063481524377847790562d0 /
            data v(50) /  1.12762596520638078522622516d0 /
            data v(51) /  1.0d0 /
            data v(52) /  1.12762596520638078522622516d0 /
            data v(53) / -1.175201193643801456882381851d0 /
            data v(54) / -0.521095305493747361622425626d0 /
            data v(55) /  0.0d0 /
            data v(56) /  0.521095305493747361622425626d0 /
            data v(57) / -0.761594155955764888119458282d0 /
            data v(58) / -0.462117157260009758502318483d0 /
            data v(59) /  0.0d0 /
            data v(60) /  0.462117157260009758592318483d0 /
C
C***FIRST EXECUTABLE STATEMENT  QCINTD
C
            if (kprint .ge. 2) write (unit=lun, fmt=9000)
C
C     Exercise routines in Category C1.
C
            y( 1) = dint(10.465890d0)
            y( 2) = dint(79.32178d0)
            y( 3) = dint(900.0d0)
            y( 4) = dint(4.0d0)
C
C     Exercise routines in Category C2.
C
            y( 5) = dsqrt(1.0d0)
            y( 6) = dsqrt(7921.0d0)
            y( 7) = dsqrt(900.0d0)
            y( 8) = dsqrt(4000d+10)
C
C     Exercise routines in Category C4A.
C
            y( 9) = dacos(-1.0d0)
            y(10) = dacos(-0.5d0)
            y(11) = dacos(0.0d0)
            y(12) = dacos(0.5d0)
            y(13) = dasin(-1.0d0)
            y(14) = dasin(-0.5d0)
            y(15) = dasin(0.0d0)
            y(16) = dasin(0.5d0)
            y(17) = datan(-1.0d0)
            y(18) = datan(-0.5d0)
            y(19) = datan(0.0d0)
            y(20) = datan(0.5d0)
            y(21) = datan2(-1.0d0,1.5d0)
            y(22) = datan2(-0.5d0,1.0d0)
            y(23) = datan2(1.0d0,-0.5d0)
            y(24) = datan2(1.5d0,-1.0d0)
            y(25) = dcos(-1.0d0)
            y(26) = dcos(-0.5d0)
            y(27) = dcos(0.0d0)
            y(28) = dcos(0.5d0)
            y(29) = dsin(-1.0d0)
            y(30) = dsin(-0.5d0)
            y(31) = dsin(0.0d0)
            y(32) = dsin(0.5d0)
            y(33) = dtan(-1.0d0)
            y(34) = dtan(-0.5d0)
            y(35) = dtan(0.0d0)
            y(36) = dtan(0.5d0)
C
C     Exercise routines in Category C4B.
C
            y(37) = dlog(10.0d0)
            y(38) = dlog(20.0d0)
            y(39) = dlog(30.0d0)
            y(40) = dlog(40.0d0)
            y(41) = dlog10(10.0d0)
            y(42) = dlog10(20.0d0)
            y(43) = dlog10(30.0d0)
            y(44) = dlog10(40.0d0)
            y(45) = dexp(1.0053d-06)
            y(46) = dexp(-1.57d-04)
            y(47) = dexp(3.8765d-05)
            y(48) = dexp(-8.03d-03)
C
C     Exercise routines in Category C4C.
C
            y(49) = dcosh(-1.0d0)
            y(50) = dcosh(-0.5d0)
            y(51) = dcosh(0.0d0)
            y(52) = dcosh(0.5d0)
            y(53) = dsinh(-1.0d0)
            y(54) = dsinh(-0.5d0)
            y(55) = dsinh(0.0d0)
            y(56) = dsinh(0.5d0)
            y(57) = dtanh(-1.0d0)
            y(58) = dtanh(-0.5d0)
            y(59) = dtanh(0.0d0)
            y(60) = dtanh(0.5d0)
C
C     Check for possible errors.
C
            ipass = 1
            errtol = dsqrt(d1mach(4))
            do 10 i = 1,60
              if (abs(v(i)-y(i)) .ge. errtol*abs(v(i))+errtol) then
                ipass = 0
                if (kprint .ge. 2) write (unit=lun, fmt=9020) i, y(i), v(i)
              endif
   10 CONTINUE
            if (ipass.ne.0 .and. kprint.ge.2) write (unit=lun, fmt=9010)
            return
 9000 FORMAT (// ' Test of double precision Fullerton intrinsic ',
     +              'routines')
 9010 FORMAT (' Double precision Fullerton intrinsic function ',
     +              'routines o.k.')
 9020 FORMAT (' For I  = ', I3, '  test fails with ', /
     +              ' computed result = ', 1p, e38.30, /
     +              ' and true result = ', e38.30)
            end
*DECK QCINTS
            subroutine qcints (lun, kprint, ipass)
C***BEGIN PROLOGUE  QCINTS
C***PURPOSE  Quick check for the single precision Fullerton
C                  elementary intrinsic functions.
C***LIBRARY   FNLIB
C***CATEGORY  C
C***TYPE            single precision (qcints-s, qcintd-d, qctinc-c)
C***KEYWORDS  QUICK CHECK
C***AUTHOR  Boland, W. Robert, (LANL)
C                 rivera, shawn m., (lanl)
C***DESCRIPTION
C
C   This subroutine does a quick check for the single precision
C   Fullerton intrinsic functions.
C
C   Parameter list-
C
C   LUN            input integer value to designate the external device unit
C                  for message output
C   KPRINT   input INTEGER value to specify amount of printing to be
C                  done by quick check
C   IPASS    output INTEGER value indicating whether tests passed or
C                  failed
C
C***REFERENCES  (NONE)
C***ROUTINES CALLED  ACOS, ALOG, ALOG10, ASIN, ATAN, ATAN2, CABS, COS,
C                          cosh, exp, r1mach, sin, sinh, sqrt, tan, tanh
C***REVISION HISTORY  (YYMMDD)
C   900711  DATE WRITTEN
C***END PROLOGUE  QCINTS
C     .. Scalar Arguments ..
            integer ipass, kprint, lun
C     .. Local Scalars ..
            real errtol
            integer i
C     .. Local Arrays ..
            real v(60), y(60)
C     .. External Functions ..
            real acos, alog, alog10, asin, atan, atan2, cabs, cos, cosh, exp,
     +     R1MACH, SIN, SINH, SQRT, TAN, TANH
C     EXTERNAL ACOS, ALOG, ALOG10, ASIN, ATAN, ATAN2, CABS, COS, COSH,
C    +               exp, r1mach, sin, sinh, sqrt, tan, tanh
C     .. Intrinsic Functions ..
            intrinsic abs, cmplx
C
C     Correct values through different calculations are stored in V(*)
C
C     .. Data statements ..
            data v( 1) /  1.0 /
            data v( 2) /  89.0 /
            data v( 3) /  30.0 /
            data v( 4) /  6.324555320337e+06 /
            data v( 5) /  10.55327437339 /
            data v( 6) /  79.32157587945 /
            data v( 7) /  901.0429556913 /
            data v( 8) /  4.00000e+13 /
            data v( 9) /  3.14159265359 /
            data v(10) /  2.094395102393 /
            data v(11) /  1.570796326795 /
            data v(12) /  1.047197551197 /
            data v(13) / -1.570796326795 /
            data v(14) / -0.5235987755983 /
            data v(15) /  0.0 /
            data v(16) /  0.5235987755983 /
            data v(17) / -0.7853981633974 /
            data v(18) / -0.4636476090008 /
            data v(19) /  0.0 /
            data v(20) /  0.4636476090008 /
            data v(21) / -0.5880026035475 /
            data v(22) / -0.4636476090008 /
            data v(23) /  2.0344438552856 /
            data v(24) /  2.158798930342 /
            data v(25) /  0.5403023058681 /
            data v(26) /  0.8775825618903 /
            data v(27) /  1.0 /
            data v(28) /  0.8775825618903 /
            data v(29) / -0.8414709848079 /
            data v(30) / -0.4794255386042 /
            data v(31) /  0.0 /
            data v(32) /  0.4794255386042 /
            data v(33) / -1.557407724655 /
            data v(34) / -0.5463024898437 /
            data v(35) /  0.0 /
            data v(36) /  0.5463024898437 /
            data v(37) /  2.302585092994 /
            data v(38) /  2.995732273554 /
            data v(39) /  3.401197381662 /
            data v(40) /  3.688879454114 /
            data v(41) /  1.0 /
            data v(42) /  1.301029995664 /
            data v(43) /  1.47712125472 /
            data v(44) /  1.602059991328 /
            data v(45) /  1.000001005301 /
            data v(46) /  0.9998430123238 /
            data v(47) /  1.000038765751 /
            data v(48) /  0.992002154326 /
            data v(49) /  1.543080634815 /
            data v(50) /  1.127625965206 /
            data v(51) /  1.0 /
            data v(52) /  1.127625965206 /
            data v(53) / -1.175201193644 /
            data v(54) / -0.5210953054937 /
            data v(55) /  0.0 /
            data v(56) /  0.5210953054937 /
            data v(57) / -0.7615941559557 /
            data v(58) / -0.46211715726 /
            data v(59) /  0.0 /
            data v(60) /  0.46211715726 /
C
C***FIRST EXECUTABLE STATEMENT  QCINTS
C
            if (kprint .ge. 2) write (unit=lun, fmt=9000)
C
C     Exercise routines in Category C2.
C
            y( 1) = sqrt(1.0)
            y( 2) = sqrt(7921.0)
            y( 3) = sqrt(900.0)
            y( 4) = sqrt(4.00000e+13)
C
C     Exercise routines in Category C4.
C
            y( 5) = cabs(cmplx(10.46,1.4))
            y( 6) = cabs(cmplx(79.32,0.5))
            y( 7) = cabs(cmplx(900.999,8.9))
            y( 8) = cabs(cmplx(4.00000e+13,1.5))
C
C     Exercise routines in Category C4A.
C
            y( 9) = acos(-1.0)
            y(10) = acos(-0.5)
            y(11) = acos(0.0)
            y(12) = acos(0.5)
            y(13) = asin(-1.0)
            y(14) = asin(-0.5)
            y(15) = asin(0.0)
            y(16) = asin(0.5)
            y(17) = atan(-1.0)
            y(18) = atan(-0.5)
            y(19) = atan(0.0)
            y(20) = atan(0.5)
            y(21) = atan2(-1.0,1.5)
            y(22) = atan2(-0.5,1.0)
            y(23) = atan2(1.0,-0.5)
            y(24) = atan2(1.5,-1.0)
            y(25) = cos(-1.0)
            y(26) = cos(-0.5)
            y(27) = cos(0.0)
            y(28) = cos(0.5)
            y(29) = sin(-1.0)
            y(30) = sin(-0.5)
            y(31) = sin(0.0)
            y(32) = sin(0.5)
            y(33) = tan(-1.0)
            y(34) = tan(-0.5)
            y(35) = tan(0.0)
            y(36) = tan(0.5)
C
C     Exercise routines in Category C4B.
C
            y(37) = alog(10.0)
            y(38) = alog(20.0)
            y(39) = alog(30.0)
            y(40) = alog(40.0)
            y(41) = alog10(10.0)
            y(42) = alog10(20.0)
            y(43) = alog10(30.0)
            y(44) = alog10(40.0)
            y(45) = exp(1.0053e-06)
            y(46) = exp(-1.57000e-04)
            y(47) = exp(3.87650e-05)
            y(48) = exp(-8.03000e-03)
C
C     Exercise routines in Category C4C.
C
            y(49) = cosh(-1.0)
            y(50) = cosh(-0.5)
            y(51) = cosh(0.0)
            y(52) = cosh(0.5)
            y(53) = sinh(-1.00000)
            y(54) = sinh(-0.50000)
            y(55) = sinh(0.000000)
            y(56) = sinh(0.500000)
            y(57) = tanh(-1.00000)
            y(58) = tanh(-0.50000)
            y(59) = tanh(0.000000)
            y(60) = tanh(0.500000)
C
C     Check for possible errors.
C
            ipass = 1
            errtol = sqrt(r1mach(4))
            do 10 i = 1,60
              if (abs(v(i)-y(i)) .ge. errtol*abs(v(i))+errtol) then
                ipass = 0
                if (kprint .ge. 2) write (unit=lun, fmt=9020) i, y(i), v(i)
              endif
   10 CONTINUE
            if (ipass.ne.0 .and. kprint.ge.2) write (unit=lun, fmt=9010)
            return
 9000 FORMAT (// ' Test of single precision Fullerton intrinsic ',
     +              'routines')
 9010 FORMAT (' Single precision Fullerton intrinsic function ',
     +              'routines o.k.')
 9020 FORMAT (' For I  = ', I3, '  test fails with ', /
     +              ' computed result = ', 1p, e22.14, /
     +              ' and true result = ', e22.14)
            end
//ft02f001 dd *
2
/*
