1`/* Implementation of the MAXLOC intrinsic 2 Copyright (C) 2002-2022 Free Software Foundation, Inc. 3 Contributed by Paul Brook <paul@nowt.org> 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 <assert.h>' 28 29include(iparm.m4)dnl 30include(ifunction.m4)dnl 31 32`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)' 33 34#define HAVE_BACK_ARG 1 35 36ARRAY_FUNCTION(0, 37` atype_name maxval; 38#if defined ('atype_inf`) 39 maxval = -atype_inf; 40#else 41 maxval = atype_min; 42#endif 43 result = 1;', 44`#if defined ('atype_nan`) 45 for (n = 0; n < len; n++, src += delta) 46 { 47 if (*src >= maxval) 48 { 49 maxval = *src; 50 result = (rtype_name)n + 1; 51 break; 52 } 53 } 54#else 55 n = 0; 56#endif 57 for (; n < len; n++, src += delta) 58 { 59 if (back ? *src >= maxval : *src > maxval) 60 { 61 maxval = *src; 62 result = (rtype_name)n + 1; 63 }', `') 64 65MASKED_ARRAY_FUNCTION(0, 66` atype_name maxval; 67#if defined ('atype_inf`) 68 maxval = -atype_inf; 69#else 70 maxval = atype_min; 71#endif 72#if defined ('atype_nan`) 73 rtype_name result2 = 0; 74#endif 75 result = 0;', 76` if (*msrc) 77 { 78#if defined ('atype_nan`) 79 if (!result2) 80 result2 = (rtype_name)n + 1; 81 if (*src >= maxval) 82#endif 83 { 84 maxval = *src; 85 result = (rtype_name)n + 1; 86 break; 87 } 88 } 89 } 90#if defined ('atype_nan`) 91 if (unlikely (n >= len)) 92 result = result2; 93 else 94#endif 95 if (back) 96 for (; n < len; n++, src += delta, msrc += mdelta) 97 { 98 if (*msrc && unlikely (*src >= maxval)) 99 { 100 maxval = *src; 101 result = (rtype_name)n + 1; 102 } 103 } 104 else 105 for (; n < len; n++, src += delta, msrc += mdelta) 106 { 107 if (*msrc && unlikely (*src > maxval)) 108 { 109 maxval = *src; 110 result = (rtype_name)n + 1; 111 }') 112 113SCALAR_ARRAY_FUNCTION(0) 114 115#endif 116