zblat1.f

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

            ELSE
               WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
               STOP
            END IF
*
   40    CONTINUE
   60 CONTINUE
*
      INCX = 1
      IF (ICASE.EQ.8) THEN
*        ZSCAL
*        Add a test for alpha equal to zero.
         CA = (0.0D0,0.0D0)
         DO 80 I = 1, 5
            MWPCT(I) = (0.0D0,0.0D0)
            MWPCS(I) = (1.0D0,1.0D0)
   80    CONTINUE
         CALL ZSCAL(5,CA,CX,INCX)
         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
      ELSE IF (ICASE.EQ.9) THEN
*        ZDSCAL
*        Add a test for alpha equal to zero.
         SA = 0.0D0
         DO 100 I = 1, 5
            MWPCT(I) = (0.0D0,0.0D0)
            MWPCS(I) = (1.0D0,1.0D0)
  100    CONTINUE
         CALL ZDSCAL(5,SA,CX,INCX)
         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
*        Add a test for alpha equal to one.
         SA = 1.0D0
         DO 120 I = 1, 5
            MWPCT(I) = CX(I)
            MWPCS(I) = CX(I)
  120    CONTINUE
         CALL ZDSCAL(5,SA,CX,INCX)
         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
*        Add a test for alpha equal to minus one.
         SA = -1.0D0
         DO 140 I = 1, 5
            MWPCT(I) = -CX(I)
            MWPCS(I) = -CX(I)
  140    CONTINUE
         CALL ZDSCAL(5,SA,CX,INCX)
         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
      END IF
      RETURN
      END
      SUBROUTINE CHECK2(SFAC)
*     .. Parameters ..
      INTEGER           NOUT
      PARAMETER         (NOUT=6)
*     .. Scalar Arguments ..
      DOUBLE PRECISION  SFAC
*     .. Scalars in Common ..
      INTEGER           ICASE, INCX, INCY, MODE, N
      LOGICAL           PASS
*     .. Local Scalars ..
      COMPLEX*16        CA
      INTEGER           I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
*     .. Local Arrays ..
      COMPLEX*16        CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
     +                  CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
     +                  CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
      INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
*     .. External Functions ..
      COMPLEX*16        ZDOTC, ZDOTU
      EXTERNAL          ZDOTC, ZDOTU
*     .. External Subroutines ..
      EXTERNAL          ZAXPY, ZCOPY, ZSWAP, CTEST
*     .. Intrinsic Functions ..
      INTRINSIC         ABS, MIN
*     .. Common blocks ..
      COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
*     .. Data statements ..
      DATA              CA/(0.4D0,-0.7D0)/
      DATA              INCXS/1, 2, -2, -1/
      DATA              INCYS/1, -2, 1, -2/
      DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
      DATA              NS/0, 1, 2, 4/
      DATA              CX1/(0.7D0,-0.8D0), (-0.4D0,-0.7D0),
     +                  (-0.1D0,-0.9D0), (0.2D0,-0.8D0),
     +                  (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/
      DATA              CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0),
     +                  (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0),
     +                  (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/
      DATA              ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0),
     +                  (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.32D0,-1.41D0), (-1.55D0,0.5D0),
     +                  (0.03D0,-0.89D0), (-0.38D0,-0.96D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
      DATA              ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
     +                  (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.78D0,0.06D0), (-0.9D0,0.5D0),
     +                  (0.06D0,-0.13D0), (0.1D0,-0.5D0),
     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
     +                  (0.52D0,-1.51D0)/
      DATA              ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
     +                  (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.78D0,0.06D0), (-1.54D0,0.97D0),
     +                  (0.03D0,-0.89D0), (-0.18D0,-1.31D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
      DATA              ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0),
     +                  (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0),
     +                  (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0),
     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
     +                  (0.32D0,-1.16D0)/
      DATA              CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0),
     +                  (0.65D0,-0.47D0), (-0.34D0,-1.22D0),
     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
     +                  (-0.59D0,-1.46D0), (-1.04D0,-0.04D0),
     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
     +                  (-0.83D0,0.59D0), (0.07D0,-0.37D0),
     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
     +                  (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/
      DATA              CT6/(0.0D0,0.0D0), (0.90D0,0.06D0),
     +                  (0.91D0,-0.77D0), (1.80D0,-0.10D0),
     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0),
     +                  (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0),
     +                  (-0.55D0,0.23D0), (0.83D0,-0.39D0),
     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0),
     +                  (1.95D0,1.22D0)/
      DATA              ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
     +                  (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
      DATA              ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0),
     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.2D0),
     +                  (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0),
     +                  (0.6D0,-0.6D0)/
      DATA              ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0),
     +                  (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0),
     +                  (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/
      DATA              ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
     +                  (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
      DATA              ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.9D0),
     +                  (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0)/
      DATA              ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
     +                  (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0),
     +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
     +                  (0.7D0,-0.8D0)/
      DATA              ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
     +                  (-0.9D0,-0.4D0), (-0.1D0,-0.9D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0)/
      DATA              ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0),
     +                  (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),