/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:04 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "dasum.h" #include double /*FUNCTION*/ dasum( long n, double x[], long incx) { long int _d_l, _d_m, _do0, _do1, i, m, mp1, ns; double dasum_v; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const X = &x[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1994-11-11 DASUM Krogh Declared all vars. *>> 1994-10-20 DASUM Krogh Changes to use M77CON *>> 1994-04-19 DASUM Krogh Minor -- Made diff. precision line up. *>> 1985-08-02 DASUM Lawson Initial code. *--D replaces "?": ?ASUM * * RETURNS SUM OF MAGNITUDES OF X. * DASUM = SUM FROM 0 TO N-1 OF ABS(X(1+I*INCX)) * */ dasum_v = 0.0e0; if (n <= 0) return( dasum_v ); if (incx == 1) goto L_20; /* CODE FOR INCREMENTS NOT EQUAL TO 1. * */ ns = n*incx; for (i = 1, _do0=DOCNT(i,ns,_do1 = incx); _do0 > 0; i += _do1, _do0--) { dasum_v += fabs( X[i] ); } return( dasum_v ); /* CODE FOR INCREMENTS EQUAL TO 1. * * * CLEAN-UP LOOP SO REMAINING VECTOR LENGTH IS A MULTIPLE OF 6. * */ L_20: m = n%6; if (m == 0) goto L_40; for (i = 1; i <= m; i++) { dasum_v += fabs( X[i] ); } if (n < 6) return( dasum_v ); L_40: mp1 = m + 1; for (i = mp1; i <= n; i += 6) { dasum_v += fabs( X[i] ) + fabs( X[i + 1] ) + fabs( X[i + 2] ) + fabs( X[i + 3] ) + fabs( X[i + 4] ) + fabs( X[i + 5] ); } return( dasum_v ); } /* end of function */