/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:08 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "isamax.h" #include long /*FUNCTION*/ isamax( long n, float x[], long incx) { long int _d_l, _d_m, _do0, _do1, i, ii, isamax_v, ns; float xmag, xmax; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *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 ISAMAX Krogh Declared all vars. *>> 1994-10-20 ISAMAX Krogh Changes to use M77CON *>> 1994-04-19 ISAMAX Krogh Conveted to use generic intrinsics. *>> 1987-12-09 ISAMAX Lawson Initial code. *--S replaces "?": I?AMAX * * FIND SMALLEST INDEX OF MAXIMUM MAGNITUDE OF X. * ISAMAX = FIRST I, I = 1 TO N, TO MINIMIZE ABS(X(1-INCX+I*INCX)) * */ isamax_v = 0; if (n <= 0) return( isamax_v ); isamax_v = 1; if (n <= 1) return( isamax_v ); if (incx == 1) goto L_20; /* CODE FOR INCREMENTS NOT EQUAL TO 1. * */ xmax = fabsf( X[1] ); ns = n*incx; ii = 1; for (i = 1, _do0=DOCNT(i,ns,_do1 = incx); _do0 > 0; i += _do1, _do0--) { xmag = fabsf( X[i] ); if (xmag <= xmax) goto L_5; isamax_v = ii; xmax = xmag; L_5: ii += 1; } return( isamax_v ); /* CODE FOR INCREMENTS EQUAL TO 1. * */ L_20: xmax = fabsf( X[1] ); for (i = 2; i <= n; i++) { xmag = fabsf( X[i] ); if (xmag <= xmax) goto L_30; isamax_v = i; xmax = xmag; L_30: ; } return( isamax_v ); } /* end of function */