Update *nrm2.c for negative incx following the new lapack release.

CBLAS/dnrm2.c

@@ -8,8 +8,6 @@
 
 doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
 {
-
-
     /* System generated locals */
 
     doublereal ret_val, d__1;
@@ -22,37 +20,39 @@ doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
     integer ix;
     doublereal ssq;
 
-
 /*  DNRM2 returns the euclidean norm of a vector via the function   
     name, so that   
 
        DNRM2 := sqrt( x'*x )   
 
-
-
     -- This version written on 25-October-1982.   
        Modified on 14-October-1993 to inline the call to DLASSQ.   
        Sven Hammarling, Nag Ltd.   
-
-
     
    Parameter adjustments   
        Function Body */
 #define X(I) x[(I)-1]
 
-
-    if (*n < 1 || *incx < 1) {
+    //if (*n < 1 || *incx < 1) {
+    if (*n < 1) {
 	norm = 0.;
     } else if (*n == 1) {
 	norm = abs(X(1));
     } else {
 	scale = 0.;
 	ssq = 1.;
 /*        The following loop is equivalent to this call to the LAPACK 
-  
           auxiliary routine:   
           CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
-	for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
+
+	int ixinitial = 1;
+	if (*incx < 0) {
+	    ixinitial = 1 - (*n-1)* (*incx);
+	}
+
+	int i;
+	for (i = 1,ix = ixinitial; i <= *n; i++, ix += *incx) {
+	    //for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
 	    if (X(ix) != 0.) {
 		absxi = (d__1 = X(ix), abs(d__1));
 		if (scale < absxi) {

CBLAS/dznrm2.c

@@ -29,19 +29,16 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
        DZNRM2 := sqrt( conjg( x' )*x )   
 
 
-
     -- This version written on 25-October-1982.   
        Modified on 14-October-1993 to inline the call to ZLASSQ.   
        Sven Hammarling, Nag Ltd.   
-
-
     
    Parameter adjustments   
        Function Body */
 #define X(I) x[(I)-1]
 
-
-    if (*n < 1 || *incx < 1) {
+	//    if (*n < 1 || *incx < 1) {
+    if (*n < 1) {
 	norm = 0.;
     } else {
 	scale = 0.;
@@ -50,7 +47,16 @@ doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
   
           auxiliary routine:   
           CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) */
-	for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
+
+	int ixinitial = 1;
+	if (*incx < 0) {
+	    ixinitial = 1 - (*n-1)* (*incx);
+	}
+
+	int i;
+	for (i = 1,ix = ixinitial; i <= *n; i++, ix += *incx) {
+	    //for (ix = 1; *incx < 0 ? ix >= (*n-1)*(*incx)+1 : ix <= (*n-1)*(*incx)+1; ix += *incx) {
+
 	    if (X(ix).r != 0.) {
 		temp = (d__1 = X(ix).r, abs(d__1));
 		if (scale < temp) {

CBLAS/scnrm2.c

@@ -28,20 +28,17 @@ real scnrm2_(integer *n, singlecomplex *x, integer *incx)
 
        SCNRM2 := sqrt( conjg( x' )*x )   
 
-
-
     -- This version written on 25-October-1982.   
        Modified on 14-October-1993 to inline the call to CLASSQ.   
        Sven Hammarling, Nag Ltd.   
 
-
-    
    Parameter adjustments   
        Function Body */
 #define X(I) x[(I)-1]
 
 
-    if (*n < 1 || *incx < 1) {
+    //if (*n < 1 || *incx < 1) {
+    if (*n < 1) {
 	norm = 0.f;
     } else {
 	scale = 0.f;
@@ -50,7 +47,15 @@ real scnrm2_(integer *n, singlecomplex *x, integer *incx)
   
           auxiliary routine:   
           CALL CLASSQ( N, X, INCX, SCALE, SSQ ) */
-	for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
+
+	int ixinitial = 1;
+	if (*incx < 0) {
+	    ixinitial = 1 - (*n-1)* (*incx);
+	}
+
+	int i;
+	for (i = 1,ix = ixinitial; i <= *n; i++, ix += *incx) {
+	    //for (ix = 1; *incx < 0 ? ix >= (*n-1)*(*incx)+1 : ix <= (*n-1)*(*incx)+1; ix += *incx) {
 	    if (X(ix).r != 0.f) {
 		temp = (r__1 = X(ix).r, dabs(r__1));
 		if (scale < temp) {

CBLAS/snrm2.c

@@ -9,7 +9,6 @@
 real snrm2_(integer *n, real *x, integer *incx)
 {
 
-
     /* System generated locals */
 
     real ret_val, r__1;
@@ -29,19 +28,18 @@ real snrm2_(integer *n, real *x, integer *incx)
        SNRM2 := sqrt( x'*x )   
 
 
-
     -- This version written on 25-October-1982.   
        Modified on 14-October-1993 to inline the call to SLASSQ.   
        Sven Hammarling, Nag Ltd.   
 
-
     
    Parameter adjustments   
        Function Body */
 #define X(I) x[(I)-1]
 
 
-    if (*n < 1 || *incx < 1) {
+    //if (*n < 1 || *incx < 1) {
+    if (*n < 1) {
 	norm = 0.f;
     } else if (*n == 1) {
 	norm = dabs(X(1));
@@ -52,7 +50,15 @@ real snrm2_(integer *n, real *x, integer *incx)
   
           auxiliary routine:   
           CALL SLASSQ( N, X, INCX, SCALE, SSQ ) */
-	for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
+
+	int ixinitial = 1;
+	if (*incx < 0) {
+	    ixinitial = 1 - (*n-1)* (*incx);
+	}
+
+	int i;
+	for (i = 1,ix = ixinitial; i <= *n; i++, ix += *incx) {
+	    //for (ix = 1; *incx < 0 ? ix >= (*n-1)**incx+1 : ix <= (*n-1)**incx+1; ix += *incx) {
 	    if (X(ix) != 0.f) {
 		absxi = (r__1 = X(ix), dabs(r__1));
 		if (scale < absxi) {