github.com/gonum/lapack@v0.0.0-20181123203213-e4cdc5a0bff9/internal/testdata/dlasqtest/ieeeck.f (about)

     1  *> \brief \b IEEECK
     2  *
     3  *  =========== DOCUMENTATION ===========
     4  *
     5  * Online html documentation available at 
     6  *            http://www.netlib.org/lapack/explore-html/ 
     7  *
     8  *> \htmlonly
     9  *> Download IEEECK + dependencies 
    10  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ieeeck.f"> 
    11  *> [TGZ]</a> 
    12  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ieeeck.f"> 
    13  *> [ZIP]</a> 
    14  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ieeeck.f"> 
    15  *> [TXT]</a>
    16  *> \endhtmlonly 
    17  *
    18  *  Definition:
    19  *  ===========
    20  *
    21  *       INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
    22  * 
    23  *       .. Scalar Arguments ..
    24  *       INTEGER            ISPEC
    25  *       REAL               ONE, ZERO
    26  *       ..
    27  *  
    28  *
    29  *> \par Purpose:
    30  *  =============
    31  *>
    32  *> \verbatim
    33  *>
    34  *> IEEECK is called from the ILAENV to verify that Infinity and
    35  *> possibly NaN arithmetic is safe (i.e. will not trap).
    36  *> \endverbatim
    37  *
    38  *  Arguments:
    39  *  ==========
    40  *
    41  *> \param[in] ISPEC
    42  *> \verbatim
    43  *>          ISPEC is INTEGER
    44  *>          Specifies whether to test just for inifinity arithmetic
    45  *>          or whether to test for infinity and NaN arithmetic.
    46  *>          = 0: Verify infinity arithmetic only.
    47  *>          = 1: Verify infinity and NaN arithmetic.
    48  *> \endverbatim
    49  *>
    50  *> \param[in] ZERO
    51  *> \verbatim
    52  *>          ZERO is REAL
    53  *>          Must contain the value 0.0
    54  *>          This is passed to prevent the compiler from optimizing
    55  *>          away this code.
    56  *> \endverbatim
    57  *>
    58  *> \param[in] ONE
    59  *> \verbatim
    60  *>          ONE is REAL
    61  *>          Must contain the value 1.0
    62  *>          This is passed to prevent the compiler from optimizing
    63  *>          away this code.
    64  *>
    65  *>  RETURN VALUE:  INTEGER
    66  *>          = 0:  Arithmetic failed to produce the correct answers
    67  *>          = 1:  Arithmetic produced the correct answers
    68  *> \endverbatim
    69  *
    70  *  Authors:
    71  *  ========
    72  *
    73  *> \author Univ. of Tennessee 
    74  *> \author Univ. of California Berkeley 
    75  *> \author Univ. of Colorado Denver 
    76  *> \author NAG Ltd. 
    77  *
    78  *> \date November 2011
    79  *
    80  *> \ingroup auxOTHERauxiliary
    81  *
    82  *  =====================================================================
    83        INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
    84  *
    85  *  -- LAPACK auxiliary routine (version 3.4.0) --
    86  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    87  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    88  *     November 2011
    89  *
    90  *     .. Scalar Arguments ..
    91        INTEGER            ISPEC
    92        REAL               ONE, ZERO
    93  *     ..
    94  *
    95  *  =====================================================================
    96  *
    97  *     .. Local Scalars ..
    98        REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
    99       $                   NEGZRO, NEWZRO, POSINF
   100  *     ..
   101  *     .. Executable Statements ..
   102        IEEECK = 1
   103  *
   104        POSINF = ONE / ZERO
   105        IF( POSINF.LE.ONE ) THEN
   106           IEEECK = 0
   107           RETURN
   108        END IF
   109  *
   110        NEGINF = -ONE / ZERO
   111        IF( NEGINF.GE.ZERO ) THEN
   112           IEEECK = 0
   113           RETURN
   114        END IF
   115  *
   116        NEGZRO = ONE / ( NEGINF+ONE )
   117        IF( NEGZRO.NE.ZERO ) THEN
   118           IEEECK = 0
   119           RETURN
   120        END IF
   121  *
   122        NEGINF = ONE / NEGZRO
   123        IF( NEGINF.GE.ZERO ) THEN
   124           IEEECK = 0
   125           RETURN
   126        END IF
   127  *
   128        NEWZRO = NEGZRO + ZERO
   129        IF( NEWZRO.NE.ZERO ) THEN
   130           IEEECK = 0
   131           RETURN
   132        END IF
   133  *
   134        POSINF = ONE / NEWZRO
   135        IF( POSINF.LE.ONE ) THEN
   136           IEEECK = 0
   137           RETURN
   138        END IF
   139  *
   140        NEGINF = NEGINF*POSINF
   141        IF( NEGINF.GE.ZERO ) THEN
   142           IEEECK = 0
   143           RETURN
   144        END IF
   145  *
   146        POSINF = POSINF*POSINF
   147        IF( POSINF.LE.ONE ) THEN
   148           IEEECK = 0
   149           RETURN
   150        END IF
   151  *
   152  *
   153  *
   154  *
   155  *     Return if we were only asked to check infinity arithmetic
   156  *
   157        IF( ISPEC.EQ.0 )
   158       $   RETURN
   159  *
   160        NAN1 = POSINF + NEGINF
   161  *
   162        NAN2 = POSINF / NEGINF
   163  *
   164        NAN3 = POSINF / POSINF
   165  *
   166        NAN4 = POSINF*ZERO
   167  *
   168        NAN5 = NEGINF*NEGZRO
   169  *
   170        NAN6 = NAN5*ZERO
   171  *
   172        IF( NAN1.EQ.NAN1 ) THEN
   173           IEEECK = 0
   174           RETURN
   175        END IF
   176  *
   177        IF( NAN2.EQ.NAN2 ) THEN
   178           IEEECK = 0
   179           RETURN
   180        END IF
   181  *
   182        IF( NAN3.EQ.NAN3 ) THEN
   183           IEEECK = 0
   184           RETURN
   185        END IF
   186  *
   187        IF( NAN4.EQ.NAN4 ) THEN
   188           IEEECK = 0
   189           RETURN
   190        END IF
   191  *
   192        IF( NAN5.EQ.NAN5 ) THEN
   193           IEEECK = 0
   194           RETURN
   195        END IF
   196  *
   197        IF( NAN6.EQ.NAN6 ) THEN
   198           IEEECK = 0
   199           RETURN
   200        END IF
   201  *
   202        RETURN
   203        END