dlamch.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 877 行 · 第 1/5 页

HTML
877 行
字号
12345
               LEMIN = MIN( NGPMIN, NGNMIN )
<span class="comment">*</span><span class="comment">            ( A guess; no known machine )
</span>               IWARN = .TRUE.
            END IF
<span class="comment">*</span><span class="comment">
</span>         ELSE
            LEMIN = MIN( NGPMIN, NGNMIN, GPMIN, GNMIN )
<span class="comment">*</span><span class="comment">         ( A guess; no known machine )
</span>            IWARN = .TRUE.
         END IF
         FIRST = .FALSE.
<span class="comment">*</span><span class="comment">**
</span><span class="comment">*</span><span class="comment"> Comment out this if block if EMIN is ok
</span>         IF( IWARN ) THEN
            FIRST = .TRUE.
            WRITE( 6, FMT = 9999 )LEMIN
         END IF
<span class="comment">*</span><span class="comment">**
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Assume IEEE arithmetic if we found denormalised  numbers above,
</span><span class="comment">*</span><span class="comment">        or if arithmetic seems to round in the  IEEE style,  determined
</span><span class="comment">*</span><span class="comment">        in routine <a name="DLAMC1.531"></a><a href="dlamch.f.html#DLAMC1.130">DLAMC1</a>. A true IEEE machine should have both  things
</span><span class="comment">*</span><span class="comment">        true; however, faulty machines may have one or the other.
</span><span class="comment">*</span><span class="comment">
</span>         IEEE = IEEE .OR. LIEEE1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Compute  RMIN by successive division by  BETA. We could compute
</span><span class="comment">*</span><span class="comment">        RMIN as BASE**( EMIN - 1 ),  but some machines underflow during
</span><span class="comment">*</span><span class="comment">        this computation.
</span><span class="comment">*</span><span class="comment">
</span>         LRMIN = 1
         DO 30 I = 1, 1 - LEMIN
            LRMIN = <a name="DLAMC3.542"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( LRMIN*RBASE, ZERO )
   30    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Finally, call <a name="DLAMC5.545"></a><a href="dlamch.f.html#DLAMC5.695">DLAMC5</a> to compute EMAX and RMAX.
</span><span class="comment">*</span><span class="comment">
</span>         CALL <a name="DLAMC5.547"></a><a href="dlamch.f.html#DLAMC5.695">DLAMC5</a>( LBETA, LT, LEMIN, IEEE, LEMAX, LRMAX )
      END IF
<span class="comment">*</span><span class="comment">
</span>      BETA = LBETA
      T = LT
      RND = LRND
      EPS = LEPS
      EMIN = LEMIN
      RMIN = LRMIN
      EMAX = LEMAX
      RMAX = LRMAX
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span> 9999 FORMAT( / / <span class="string">' WARNING. The value EMIN may be incorrect:-'</span>,
     $      <span class="string">'  EMIN = '</span>, I8, /
     $      <span class="string">' If, after inspection, the value EMIN looks'</span>,
     $      <span class="string">' acceptable please comment out '</span>,
     $      / <span class="string">' the IF block as marked within the code of routine'</span>,
     $      <span class="string">' <a name="DLAMC2.566"></a><a href="dlamch.f.html#DLAMC2.316">DLAMC2</a>,'</span>, / <span class="string">' otherwise supply EMIN explicitly.'</span>, / )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="DLAMC2.568"></a><a href="dlamch.f.html#DLAMC2.316">DLAMC2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">***********************************************************************
</span><span class="comment">*</span><span class="comment">
</span><a name="DLAMC3.574"></a>      DOUBLE PRECISION FUNCTION <a name="DLAMC3.574"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( A, B )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      DOUBLE PRECISION   A, B
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="DLAMC3.587"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>  is intended to force  A  and  B  to be stored prior to doing
</span><span class="comment">*</span><span class="comment">  the addition of  A  and  B ,  for use in situations where optimizers
</span><span class="comment">*</span><span class="comment">  might hold one of these in a register.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  A       (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment">  B       (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment">          The values A and B.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      <a name="DLAMC3.602"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a> = A + B
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="DLAMC3.606"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>
</span><span class="comment">*</span><span class="comment">
</span>      END
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">***********************************************************************
</span><span class="comment">*</span><span class="comment">
</span><a name="DLAMC4.612"></a>      SUBROUTINE <a name="DLAMC4.612"></a><a href="dlamch.f.html#DLAMC4.612">DLAMC4</a>( EMIN, START, BASE )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      INTEGER            BASE, EMIN
      DOUBLE PRECISION   START
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="DLAMC4.626"></a><a href="dlamch.f.html#DLAMC4.612">DLAMC4</a> is a service routine for <a name="DLAMC2.626"></a><a href="dlamch.f.html#DLAMC2.316">DLAMC2</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  EMIN    (output) INTEGER 
</span><span class="comment">*</span><span class="comment">          The minimum exponent before (gradual) underflow, computed by
</span><span class="comment">*</span><span class="comment">          setting A = START and dividing by BASE until the previous A
</span><span class="comment">*</span><span class="comment">          can not be recovered.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  START   (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment">          The starting point for determining EMIN.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  BASE    (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The base of the machine.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      INTEGER            I
      DOUBLE PRECISION   A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      DOUBLE PRECISION   <a name="DLAMC3.649"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>
      EXTERNAL           <a name="DLAMC3.650"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      A = START
      ONE = 1
      RBASE = ONE / BASE
      ZERO = 0
      EMIN = 1
      B1 = <a name="DLAMC3.659"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( A*RBASE, ZERO )
      C1 = A
      C2 = A
      D1 = A
      D2 = A
<span class="comment">*</span><span class="comment">+    WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
</span><span class="comment">*</span><span class="comment">    $       ( D1.EQ.A ).AND.( D2.EQ.A )      )LOOP
</span>   10 CONTINUE
      IF( ( C1.EQ.A ) .AND. ( C2.EQ.A ) .AND. ( D1.EQ.A ) .AND.
     $    ( D2.EQ.A ) ) THEN
         EMIN = EMIN - 1
         A = B1
         B1 = <a name="DLAMC3.671"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( A / BASE, ZERO )
         C1 = <a name="DLAMC3.672"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( B1*BASE, ZERO )
         D1 = ZERO
         DO 20 I = 1, BASE
            D1 = D1 + B1
   20    CONTINUE
         B2 = <a name="DLAMC3.677"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( A*RBASE, ZERO )
         C2 = <a name="DLAMC3.678"></a><a href="dlamch.f.html#DLAMC3.574">DLAMC3</a>( B2 / RBASE, ZERO )
         D2 = ZERO
         DO 30 I = 1, BASE
            D2 = D2 + B2
   30    CONTINUE
         GO TO 10
      END IF
<span class="comment">*</span><span class="comment">+    END WHILE
12345

dlamch.f.html - 源码说明

本页面展示了「famous linear algebra library (LAPACK) ports to windows」中的 dlamch.f.html 源码文件，采用 HTML 编程语言编写，共 877 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与algebra相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?