subroutine check1

(

double precision

SFAC

)

Definition at line 119 of file zblat1.f.

*     .. 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
      DOUBLE PRECISION  sa
      INTEGER           i, j, len, np1
*     .. Local Arrays ..
      COMPLEX*16        ctrue5(8,5,2), ctrue6(8,5,2), cv(8,5,2), cx(8),
     +                  mwpcs(5), mwpct(5)
      DOUBLE PRECISION  strue2(5), strue4(5)
      INTEGER           itrue3(5)
*     .. External Functions ..
      DOUBLE PRECISION  dzasum, dznrm2
      INTEGER           izamax
      EXTERNAL          dzasum, dznrm2, izamax
*     .. External Subroutines ..
      EXTERNAL          zscal, zdscal, ctest, itest1, stest1
*     .. Intrinsic Functions ..
      INTRINSIC         max
*     .. Common blocks ..
      COMMON            /combla/icase, n, incx, incy, mode, pass
*     .. Data statements ..
      DATA              sa, ca/0.3d0, (0.4d0,-0.7d0)/
      DATA              ((cv(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (0.3d0,-0.4d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (0.1d0,-0.3d0), (0.5d0,-0.1d0), (5.0d0,6.0d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (0.1d0,0.1d0),
     +                  (-0.6d0,0.1d0), (0.1d0,-0.3d0), (7.0d0,8.0d0),
     +                  (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
     +                  (7.0d0,8.0d0), (0.3d0,0.1d0), (0.5d0,0.0d0),
     +                  (0.0d0,0.5d0), (0.0d0,0.2d0), (2.0d0,3.0d0),
     +                  (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
      DATA              ((cv(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (0.3d0,-0.4d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (0.1d0,-0.3d0), (8.0d0,9.0d0), (0.5d0,-0.1d0),
     +                  (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
     +                  (2.0d0,5.0d0), (2.0d0,5.0d0), (0.1d0,0.1d0),
     +                  (3.0d0,6.0d0), (-0.6d0,0.1d0), (4.0d0,7.0d0),
     +                  (0.1d0,-0.3d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
     +                  (7.0d0,2.0d0), (0.3d0,0.1d0), (5.0d0,8.0d0),
     +                  (0.5d0,0.0d0), (6.0d0,9.0d0), (0.0d0,0.5d0),
     +                  (8.0d0,3.0d0), (0.0d0,0.2d0), (9.0d0,4.0d0)/
      DATA              strue2/0.0d0, 0.5d0, 0.6d0, 0.7d0, 0.8d0/
      DATA              strue4/0.0d0, 0.7d0, 1.0d0, 1.3d0, 1.6d0/
      DATA              ((ctrue5(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (-0.16d0,-0.37d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (-0.17d0,-0.19d0), (0.13d0,-0.39d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
     +                  (0.11d0,-0.03d0), (-0.17d0,0.46d0),
     +                  (-0.17d0,-0.19d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
     +                  (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
     +                  (0.19d0,-0.17d0), (0.20d0,-0.35d0),
     +                  (0.35d0,0.20d0), (0.14d0,0.08d0),
     +                  (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0),
     +                  (2.0d0,3.0d0)/
      DATA              ((ctrue5(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (-0.16d0,-0.37d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (-0.17d0,-0.19d0), (8.0d0,9.0d0),
     +                  (0.13d0,-0.39d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
     +                  (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
     +                  (0.11d0,-0.03d0), (3.0d0,6.0d0),
     +                  (-0.17d0,0.46d0), (4.0d0,7.0d0),
     +                  (-0.17d0,-0.19d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
     +                  (7.0d0,2.0d0), (0.19d0,-0.17d0), (5.0d0,8.0d0),
     +                  (0.20d0,-0.35d0), (6.0d0,9.0d0),
     +                  (0.35d0,0.20d0), (8.0d0,3.0d0),
     +                  (0.14d0,0.08d0), (9.0d0,4.0d0)/
      DATA              ((ctrue6(i,j,1),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (1.0d0,2.0d0), (1.0d0,2.0d0),
     +                  (1.0d0,2.0d0), (0.09d0,-0.12d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (3.0d0,4.0d0), (3.0d0,4.0d0), (3.0d0,4.0d0),
     +                  (0.03d0,-0.09d0), (0.15d0,-0.03d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
     +                  (5.0d0,6.0d0), (5.0d0,6.0d0), (5.0d0,6.0d0),
     +                  (0.03d0,0.03d0), (-0.18d0,0.03d0),
     +                  (0.03d0,-0.09d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
     +                  (7.0d0,8.0d0), (7.0d0,8.0d0), (7.0d0,8.0d0),
     +                  (0.09d0,0.03d0), (0.15d0,0.00d0),
     +                  (0.00d0,0.15d0), (0.00d0,0.06d0), (2.0d0,3.0d0),
     +                  (2.0d0,3.0d0), (2.0d0,3.0d0), (2.0d0,3.0d0)/
      DATA              ((ctrue6(i,j,2),i=1,8),j=1,5)/(0.1d0,0.1d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (4.0d0,5.0d0), (4.0d0,5.0d0),
     +                  (4.0d0,5.0d0), (0.09d0,-0.12d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (6.0d0,7.0d0), (6.0d0,7.0d0), (6.0d0,7.0d0),
     +                  (0.03d0,-0.09d0), (8.0d0,9.0d0),
     +                  (0.15d0,-0.03d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
     +                  (2.0d0,5.0d0), (2.0d0,5.0d0), (2.0d0,5.0d0),
     +                  (0.03d0,0.03d0), (3.0d0,6.0d0),
     +                  (-0.18d0,0.03d0), (4.0d0,7.0d0),
     +                  (0.03d0,-0.09d0), (7.0d0,2.0d0), (7.0d0,2.0d0),
     +                  (7.0d0,2.0d0), (0.09d0,0.03d0), (5.0d0,8.0d0),
     +                  (0.15d0,0.00d0), (6.0d0,9.0d0), (0.00d0,0.15d0),
     +                  (8.0d0,3.0d0), (0.00d0,0.06d0), (9.0d0,4.0d0)/
      DATA              itrue3/0, 1, 2, 2, 2/
*     .. Executable Statements ..
      DO 60 incx = 1, 2
         DO 40 np1 = 1, 5
            n = np1 - 1
            len = 2*max(n,1)
*           .. Set vector arguments ..
            DO 20 i = 1, len
               cx(i) = cv(i,np1,incx)
   20       CONTINUE
            IF (icase.EQ.6) THEN
*              .. DZNRM2 ..
               CALL stest1(dznrm2(n,cx,incx),strue2(np1),strue2(np1),
     +                     sfac)
            ELSE IF (icase.EQ.7) THEN
*              .. DZASUM ..
               CALL stest1(dzasum(n,cx,incx),strue4(np1),strue4(np1),
     +                     sfac)
            ELSE IF (icase.EQ.8) THEN
*              .. ZSCAL ..
               CALL zscal(n,ca,cx,incx)
               CALL ctest(len,cx,ctrue5(1,np1,incx),ctrue5(1,np1,incx),
     +                    sfac)
            ELSE IF (icase.EQ.9) THEN
*              .. ZDSCAL ..
               CALL zdscal(n,sa,cx,incx)
               CALL ctest(len,cx,ctrue6(1,np1,incx),ctrue6(1,np1,incx),
     +                    sfac)
            ELSE IF (icase.EQ.10) THEN
*              .. IZAMAX ..
               CALL itest1(izamax(n,cx,incx),itrue3(np1))
            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

Here is the call graph for this function: