sget32.f

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

                              RES = RES / DEN
                              IF( SCALE.GT.ONE )
     $                           RES = RES + ONE / EPS
                              RES = RES + ABS( XNORM-XNRM ) /
     $                              MAX( SMLNUM, XNORM ) / EPS
                              IF( RES.GT.RMAX ) THEN
                                 LMAX = KNT
                                 RMAX = RES
                              END IF
   40                      CONTINUE
   50                   CONTINUE
   60                CONTINUE
   70             CONTINUE
   80          CONTINUE
*
               N1 = 1
               N2 = 2
               DO 130 ITR = 1, 8
                  DO 120 ITRSCL = 1, 3
                     DO 110 ITL = 1, 3
                        DO 100 IB1 = 1, 3
                           DO 90 IB2 = 1, 3
                              B( 1, 1 ) = VAL( IB1 )
                              B( 1, 2 ) = -TWO*VAL( IB2 )
                              TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
     $                                     VAL( ITRSCL )
                              TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
     $                                     VAL( ITRSCL )
                              TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
     $                                     VAL( ITRSCL )
                              TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
     $                                     VAL( ITRSCL )
                              TL( 1, 1 ) = VAL( ITL )
                              KNT = KNT + 1
                              CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2,
     $                                     TL, 2, TR, 2, B, 2, SCALE, X,
     $                                     2, XNORM, INFO )
                              IF( INFO.NE.0 )
     $                           NINFO = NINFO + 1
                              IF( LTRANR ) THEN
                                 TMP = TR( 1, 2 )
                                 TR( 1, 2 ) = TR( 2, 1 )
                                 TR( 2, 1 ) = TMP
                              END IF
                              TNRM = ABS( TL( 1, 1 ) ) +
     $                               ABS( TR( 1, 1 ) ) +
     $                               ABS( TR( 1, 2 ) ) +
     $                               ABS( TR( 2, 2 ) ) +
     $                               ABS( TR( 2, 1 ) )
                              XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
                              RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
     $                              1 ) ) )*( X( 1, 1 ) )+
     $                              ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )-
     $                              ( SCALE*B( 1, 1 ) ) )
                              RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2,
     $                              2 ) ) )*( X( 1, 2 ) )+
     $                              ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )-
     $                              ( SCALE*B( 1, 2 ) ) )
                              DEN = MAX( SMLNUM, SMLNUM*XNRM,
     $                              ( TNRM*EPS )*XNRM )
                              RES = RES / DEN
                              IF( SCALE.GT.ONE )
     $                           RES = RES + ONE / EPS
                              RES = RES + ABS( XNORM-XNRM ) /
     $                              MAX( SMLNUM, XNORM ) / EPS
                              IF( RES.GT.RMAX ) THEN
                                 LMAX = KNT
                                 RMAX = RES
                              END IF
   90                      CONTINUE
  100                   CONTINUE
  110                CONTINUE
  120             CONTINUE
  130          CONTINUE
*
               N1 = 2
               N2 = 2
               DO 200 ITR = 1, 8
                  DO 190 ITRSCL = 1, 3
                     DO 180 ITL = 1, 8
                        DO 170 ITLSCL = 1, 3
                           DO 160 IB1 = 1, 3
                              DO 150 IB2 = 1, 3
                                 DO 140 IB3 = 1, 3
                                    B( 1, 1 ) = VAL( IB1 )
                                    B( 2, 1 ) = -FOUR*VAL( IB2 )
                                    B( 1, 2 ) = -TWO*VAL( IB3 )
                                    B( 2, 2 ) = EIGHT*
     $                                          MIN( VAL( IB1 ), VAL
     $                                          ( IB2 ), VAL( IB3 ) )
                                    TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
     $                                           VAL( ITRSCL )
                                    TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
     $                                           VAL( ITRSCL )
                                    TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
     $                                           VAL( ITRSCL )
                                    TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
     $                                           VAL( ITRSCL )
                                    TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
     $                                           VAL( ITLSCL )
                                    TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
     $                                           VAL( ITLSCL )
                                    TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
     $                                           VAL( ITLSCL )
                                    TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
     $                                           VAL( ITLSCL )
                                    KNT = KNT + 1
                                    CALL SLASY2( LTRANL, LTRANR, ISGN,
     $                                           N1, N2, TL, 2, TR, 2,
     $                                           B, 2, SCALE, X, 2,
     $                                           XNORM, INFO )
                                    IF( INFO.NE.0 )
     $                                 NINFO = NINFO + 1
                                    IF( LTRANR ) THEN
                                       TMP = TR( 1, 2 )
                                       TR( 1, 2 ) = TR( 2, 1 )
                                       TR( 2, 1 ) = TMP
                                    END IF
                                    IF( LTRANL ) THEN
                                       TMP = TL( 1, 2 )
                                       TL( 1, 2 ) = TL( 2, 1 )
                                       TL( 2, 1 ) = TMP
                                    END IF
                                    TNRM = ABS( TR( 1, 1 ) ) +
     $                                     ABS( TR( 2, 1 ) ) +
     $                                     ABS( TR( 1, 2 ) ) +
     $                                     ABS( TR( 2, 2 ) ) +
     $                                     ABS( TL( 1, 1 ) ) +
     $                                     ABS( TL( 2, 1 ) ) +
     $                                     ABS( TL( 1, 2 ) ) +
     $                                     ABS( TL( 2, 2 ) )
                                    XNRM = MAX( ABS( X( 1, 1 ) )+
     $                                     ABS( X( 1, 2 ) ),
     $                                     ABS( X( 2, 1 ) )+
     $                                     ABS( X( 2, 2 ) ) )
                                    RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
     $                                    1 ) ) )*( X( 1, 1 ) )+
     $                                    ( SGN*TR( 2, 1 ) )*
     $                                    ( X( 1, 2 ) )+( TL( 1, 2 ) )*
     $                                    ( X( 2, 1 ) )-
     $                                    ( SCALE*B( 1, 1 ) ) )
                                    RES = RES + ABS( ( TL( 1, 1 ) )*
     $                                    ( X( 1, 2 ) )+
     $                                    ( SGN*TR( 1, 2 ) )*
     $                                    ( X( 1, 1 ) )+
     $                                    ( SGN*TR( 2, 2 ) )*
     $                                    ( X( 1, 2 ) )+( TL( 1, 2 ) )*
     $                                    ( X( 2, 2 ) )-
     $                                    ( SCALE*B( 1, 2 ) ) )
                                    RES = RES + ABS( ( TL( 2, 1 ) )*
     $                                    ( X( 1, 1 ) )+
     $                                    ( SGN*TR( 1, 1 ) )*
     $                                    ( X( 2, 1 ) )+
     $                                    ( SGN*TR( 2, 1 ) )*
     $                                    ( X( 2, 2 ) )+( TL( 2, 2 ) )*
     $                                    ( X( 2, 1 ) )-
     $                                    ( SCALE*B( 2, 1 ) ) )
                                    RES = RES + ABS( ( ( TL( 2,
     $                                    2 )+SGN*TR( 2, 2 ) ) )*
     $                                    ( X( 2, 2 ) )+
     $                                    ( SGN*TR( 1, 2 ) )*
     $                                    ( X( 2, 1 ) )+( TL( 2, 1 ) )*
     $                                    ( X( 1, 2 ) )-
     $                                    ( SCALE*B( 2, 2 ) ) )
                                    DEN = MAX( SMLNUM, SMLNUM*XNRM,
     $                                    ( TNRM*EPS )*XNRM )
                                    RES = RES / DEN
                                    IF( SCALE.GT.ONE )
     $                                 RES = RES + ONE / EPS
                                    RES = RES + ABS( XNORM-XNRM ) /
     $                                    MAX( SMLNUM, XNORM ) / EPS
                                    IF( RES.GT.RMAX ) THEN
                                       LMAX = KNT
                                       RMAX = RES
                                    END IF
  140                            CONTINUE
  150                         CONTINUE
  160                      CONTINUE
  170                   CONTINUE
  180                CONTINUE
  190             CONTINUE
  200          CONTINUE
  210       CONTINUE
  220    CONTINUE
  230 CONTINUE
*
      RETURN
*
*     End of SGET32
*
      END