check1()

subroutine check1

(

double precision

sfac

)

Definition at line 248 of file dblat1.f.

*     .. Parameters ..
      DOUBLE PRECISION  THRESH
      INTEGER           NOUT
      parameter(nout=6, thresh=10.0d0)
*     .. Scalar Arguments ..
      DOUBLE PRECISION  SFAC
*     .. Scalars in Common ..
      INTEGER           ICASE, INCX, INCY, N
      LOGICAL           PASS
*     .. Local Scalars ..
      INTEGER           I, IX, LEN, NP1
*     .. Local Arrays ..
      DOUBLE PRECISION  DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
     +                  DVR(8), SA(10), STEMP(1), STRUE(8), SX(8),
     +                  SXR(15)
      INTEGER           ITRUE2(5), ITRUEC(5)
*     .. External Functions ..
      DOUBLE PRECISION  DASUM, DNRM2
      INTEGER           IDAMAX
      EXTERNAL          dasum, dnrm2, idamax
*     .. External Subroutines ..
      EXTERNAL          itest1, db1nrm2, dscal, stest, stest1
*     .. Intrinsic Functions ..
      INTRINSIC         max
*     .. Common blocks ..
      COMMON            /combla/icase, n, incx, incy, pass
*     .. Data statements ..
      DATA              sa/0.3d0, -1.0d0, 0.0d0, 1.0d0, 0.3d0, 0.3d0,
     +                  0.3d0, 0.3d0, 0.3d0, 0.3d0/
      DATA              dv/0.1d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
     +                  2.0d0, 2.0d0, 0.3d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0,
     +                  3.0d0, 3.0d0, 3.0d0, 0.3d0, -0.4d0, 4.0d0,
     +                  4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 0.2d0,
     +                  -0.6d0, 0.3d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0,
     +                  5.0d0, 0.1d0, -0.3d0, 0.5d0, -0.1d0, 6.0d0,
     +                  6.0d0, 6.0d0, 6.0d0, 0.1d0, 8.0d0, 8.0d0, 8.0d0,
     +                  8.0d0, 8.0d0, 8.0d0, 8.0d0, 0.3d0, 9.0d0, 9.0d0,
     +                  9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 0.3d0, 2.0d0,
     +                  -0.4d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
     +                  0.2d0, 3.0d0, -0.6d0, 5.0d0, 0.3d0, 2.0d0,
     +                  2.0d0, 2.0d0, 0.1d0, 4.0d0, -0.3d0, 6.0d0,
     +                  -0.5d0, 7.0d0, -0.1d0, 3.0d0/
      DATA              dvr/8.0d0, -7.0d0, 9.0d0, 5.0d0, 9.0d0, 8.0d0,
     +                  7.0d0, 7.0d0/
      DATA              dtrue1/0.0d0, 0.3d0, 0.5d0, 0.7d0, 0.6d0/
      DATA              dtrue3/0.0d0, 0.3d0, 0.7d0, 1.1d0, 1.0d0/
      DATA              dtrue5/0.10d0, 2.0d0, 2.0d0, 2.0d0, 2.0d0,
     +                  2.0d0, 2.0d0, 2.0d0, -0.3d0, 3.0d0, 3.0d0,
     +                  3.0d0, 3.0d0, 3.0d0, 3.0d0, 3.0d0, 0.0d0, 0.0d0,
     +                  4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0, 4.0d0,
     +                  0.20d0, -0.60d0, 0.30d0, 5.0d0, 5.0d0, 5.0d0,
     +                  5.0d0, 5.0d0, 0.03d0, -0.09d0, 0.15d0, -0.03d0,
     +                  6.0d0, 6.0d0, 6.0d0, 6.0d0, 0.10d0, 8.0d0,
     +                  8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0, 8.0d0,
     +                  0.09d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0, 9.0d0,
     +                  9.0d0, 9.0d0, 0.09d0, 2.0d0, -0.12d0, 2.0d0,
     +                  2.0d0, 2.0d0, 2.0d0, 2.0d0, 0.06d0, 3.0d0,
     +                  -0.18d0, 5.0d0, 0.09d0, 2.0d0, 2.0d0, 2.0d0,
     +                  0.03d0, 4.0d0, -0.09d0, 6.0d0, -0.15d0, 7.0d0,
     +                  -0.03d0, 3.0d0/
      DATA              itrue2/0, 1, 2, 2, 3/
      DATA              itruec/0, 1, 1, 1, 1/
*     .. Executable Statements ..
      DO 80 incx = 1, 2
         DO 60 np1 = 1, 5
            n = np1 - 1
            len = 2*max(n,1)
*           .. Set vector arguments ..
            DO 20 i = 1, len
               sx(i) = dv(i,np1,incx)
   20       CONTINUE
*
            IF (icase.EQ.7) THEN
*              .. DNRM2 ..
*              Test scaling when some entries are tiny or huge
               CALL db1nrm2(n,(incx-2)*2,thresh)
               CALL db1nrm2(n,incx,thresh)
*              Test with hardcoded mid range entries
               stemp(1) = dtrue1(np1)
               CALL stest1(dnrm2(n,sx,incx),stemp(1),stemp,sfac)
            ELSE IF (icase.EQ.8) THEN
*              .. DASUM ..
               stemp(1) = dtrue3(np1)
               CALL stest1(dasum(n,sx,incx),stemp(1),stemp,sfac)
            ELSE IF (icase.EQ.9) THEN
*              .. DSCAL ..
               CALL dscal(n,sa((incx-1)*5+np1),sx,incx)
               DO 40 i = 1, len
                  strue(i) = dtrue5(i,np1,incx)
   40          CONTINUE
               CALL stest(len,sx,strue,strue,sfac)
            ELSE IF (icase.EQ.10) THEN
*              .. IDAMAX ..
               CALL itest1(idamax(n,sx,incx),itrue2(np1))
               DO 100 i = 1, len
                  sx(i) = 42.0d0
  100          CONTINUE
               CALL itest1(idamax(n,sx,incx),itruec(np1))
            ELSE
               WRITE (nout,*) ' Shouldn''t be here in CHECK1'
               stop
            END IF
   60    CONTINUE
         IF (icase.EQ.10) THEN
            n = 8
            ix = 1
            DO 120 i = 1, n
               sxr(ix) = dvr(i)
               ix = ix + incx
  120       CONTINUE
            CALL itest1(idamax(n,sxr,incx),3)
         END IF
   80 CONTINUE
      RETURN
*
*     End of CHECK1
*

Here is the call graph for this function: