Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016 doublereal sasum_(integer *n, real *sx, integer *incx)
00017 {
00018
00019 integer i__1, i__2;
00020 real ret_val, r__1, r__2, r__3, r__4, r__5, r__6;
00021
00022
00023 integer i__, m, mp1, nincx;
00024 real stemp;
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046 --sx;
00047
00048
00049 ret_val = 0.f;
00050 stemp = 0.f;
00051 if (*n <= 0 || *incx <= 0) {
00052 return ret_val;
00053 }
00054 if (*incx == 1) {
00055 goto L20;
00056 }
00057
00058
00059
00060 nincx = *n * *incx;
00061 i__1 = nincx;
00062 i__2 = *incx;
00063 for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
00064 stemp += (r__1 = sx[i__], dabs(r__1));
00065
00066 }
00067 ret_val = stemp;
00068 return ret_val;
00069
00070
00071
00072
00073
00074
00075 L20:
00076 m = *n % 6;
00077 if (m == 0) {
00078 goto L40;
00079 }
00080 i__2 = m;
00081 for (i__ = 1; i__ <= i__2; ++i__) {
00082 stemp += (r__1 = sx[i__], dabs(r__1));
00083
00084 }
00085 if (*n < 6) {
00086 goto L60;
00087 }
00088 L40:
00089 mp1 = m + 1;
00090 i__2 = *n;
00091 for (i__ = mp1; i__ <= i__2; i__ += 6) {
00092 stemp = stemp + (r__1 = sx[i__], dabs(r__1)) + (r__2 = sx[i__ + 1],
00093 dabs(r__2)) + (r__3 = sx[i__ + 2], dabs(r__3)) + (r__4 = sx[
00094 i__ + 3], dabs(r__4)) + (r__5 = sx[i__ + 4], dabs(r__5)) + (
00095 r__6 = sx[i__ + 5], dabs(r__6));
00096
00097 }
00098 L60:
00099 ret_val = stemp;
00100 return ret_val;
00101 }