clacn2.f.html

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

   10    CONTINUE
         KASE = 1
         ISAVE( 1 ) = 1
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      GO TO ( 20, 40, 70, 90, 120 )ISAVE( 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 1)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   20 CONTINUE
      IF( N.EQ.1 ) THEN
         V( 1 ) = X( 1 )
         EST = ABS( V( 1 ) )
<span class="comment">*</span><span class="comment">        ... QUIT
</span>         GO TO 130
      END IF
      EST = <a name="SCSUM1.123"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, X, 1 )
<span class="comment">*</span><span class="comment">
</span>      DO 30 I = 1, N
         ABSXI = ABS( X( I ) )
         IF( ABSXI.GT.SAFMIN ) THEN
            X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
     $               AIMAG( X( I ) ) / ABSXI )
         ELSE
            X( I ) = CONE
         END IF
   30 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 2
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 2)
</span><span class="comment">*</span><span class="comment">     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>   40 CONTINUE
      ISAVE( 2 ) = <a name="ICMAX1.142"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>( N, X, 1 )
      ISAVE( 3 ) = 2
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
</span><span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      DO 60 I = 1, N
         X( I ) = CZERO
   60 CONTINUE
      X( ISAVE( 2 ) ) = CONE
      KASE = 1
      ISAVE( 1 ) = 3
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 3)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>   70 CONTINUE
      CALL CCOPY( N, X, 1, V, 1 )
      ESTOLD = EST
      EST = <a name="SCSUM1.162"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, V, 1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     TEST FOR CYCLING.
</span>      IF( EST.LE.ESTOLD )
     $   GO TO 100
<span class="comment">*</span><span class="comment">
</span>      DO 80 I = 1, N
         ABSXI = ABS( X( I ) )
         IF( ABSXI.GT.SAFMIN ) THEN
            X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
     $               AIMAG( X( I ) ) / ABSXI )
         ELSE
            X( I ) = CONE
         END IF
   80 CONTINUE
      KASE = 2
      ISAVE( 1 ) = 4
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 4)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
</span><span class="comment">*</span><span class="comment">
</span>   90 CONTINUE
      JLAST = ISAVE( 2 )
      ISAVE( 2 ) = <a name="ICMAX1.186"></a><a href="icmax1.f.html#ICMAX1.1">ICMAX1</a>( N, X, 1 )
      IF( ( ABS( X( JLAST ) ).NE.ABS( X( ISAVE( 2 ) ) ) ) .AND.
     $    ( ISAVE( 3 ).LT.ITMAX ) ) THEN
         ISAVE( 3 ) = ISAVE( 3 ) + 1
         GO TO 50
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ITERATION COMPLETE.  FINAL STAGE.
</span><span class="comment">*</span><span class="comment">
</span>  100 CONTINUE
      ALTSGN = ONE
      DO 110 I = 1, N
         X( I ) = CMPLX( ALTSGN*( ONE + REAL( I-1 ) / REAL( N-1 ) ) )
         ALTSGN = -ALTSGN
  110 CONTINUE
      KASE = 1
      ISAVE( 1 ) = 5
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ................ ENTRY   (ISAVE( 1 ) = 5)
</span><span class="comment">*</span><span class="comment">     X HAS BEEN OVERWRITTEN BY A*X.
</span><span class="comment">*</span><span class="comment">
</span>  120 CONTINUE
      TEMP = TWO*( <a name="SCSUM1.209"></a><a href="scsum1.f.html#SCSUM1.1">SCSUM1</a>( N, X, 1 ) / REAL( 3*N ) )
      IF( TEMP.GT.EST ) THEN
         CALL CCOPY( N, X, 1, V, 1 )
         EST = TEMP
      END IF
<span class="comment">*</span><span class="comment">
</span>  130 CONTINUE
      KASE = 0
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="CLACN2.219"></a><a href="clacn2.f.html#CLACN2.1">CLACN2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>