1`/* Implementation of the MAXLOC intrinsic 2 Copyright (C) 2017-2020 Free Software Foundation, Inc. 3 Contributed by Thomas Koenig 4 5This file is part of the GNU Fortran runtime library (libgfortran). 6 7Libgfortran is free software; you can redistribute it and/or 8modify it under the terms of the GNU General Public 9License as published by the Free Software Foundation; either 10version 3 of the License, or (at your option) any later version. 11 12Libgfortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17Under Section 7 of GPL version 3, you are granted additional 18permissions described in the GCC Runtime Library Exception, version 193.1, as published by the Free Software Foundation. 20 21You should have received a copy of the GNU General Public License and 22a copy of the GCC Runtime Library Exception along with this program; 23see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24<http://www.gnu.org/licenses/>. */ 25 26#include "libgfortran.h" 27#include <stdlib.h> 28#include <string.h> 29#include <assert.h> 30#include <limits.h>' 31 32include(iparm.m4)dnl 33include(iforeach-s.m4)dnl 34 35`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' 36 37#define HAVE_BACK_ARG 1 38 39FOREACH_FUNCTION( 40` const atype_name *maxval; 41 maxval = NULL;' 42, 43` if (maxval == NULL || (back ? compare_fcn (base, maxval, len) >= 0 : 44 compare_fcn (base, maxval, len) > 0)) 45 { 46 maxval = base; 47 for (n = 0; n < rank; n++) 48 dest[n * dstride] = count[n] + 1; 49 }') 50 51MASKED_FOREACH_FUNCTION( 52` const atype_name *maxval; 53 54 maxval = NULL;' 55, 56` if (*mbase && 57 (maxval == NULL || (back ? compare_fcn (base, maxval, len) >= 0: 58 compare_fcn (base, maxval, len) > 0))) 59 { 60 maxval = base; 61 for (n = 0; n < rank; n++) 62 dest[n * dstride] = count[n] + 1; 63 }') 64 65SCALAR_FOREACH_FUNCTION(`0') 66#endif 67