1`/* Implementation of the MINLOC intrinsic 2 Copyright (C) 2002-2018 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 minval; 38#if defined ('atype_inf`) 39 minval = atype_inf; 40#else 41 minval = atype_max; 42#endif 43 result = 1;', 44`#if defined ('atype_nan`) 45 if (*src <= minval) 46 { 47 minval = *src; 48 result = (rtype_name)n + 1; 49 break; 50 } 51 } 52 for (; n < len; n++, src += delta) 53 { 54#endif 55 if (*src < minval) 56 { 57 minval = *src; 58 result = (rtype_name)n + 1; 59 }') 60 61MASKED_ARRAY_FUNCTION(0, 62` atype_name minval; 63#if defined ('atype_inf`) 64 minval = atype_inf; 65#else 66 minval = atype_max; 67#endif 68#if defined ('atype_nan`) 69 rtype_name result2 = 0; 70#endif 71 result = 0;', 72` if (*msrc) 73 { 74#if defined ('atype_nan`) 75 if (!result2) 76 result2 = (rtype_name)n + 1; 77 if (*src <= minval) 78#endif 79 { 80 minval = *src; 81 result = (rtype_name)n + 1; 82 break; 83 } 84 } 85 } 86#if defined ('atype_nan`) 87 if (unlikely (n >= len)) 88 result = result2; 89 else 90#endif 91 for (; n < len; n++, src += delta, msrc += mdelta) 92 { 93 if (*msrc && *src < minval) 94 { 95 minval = *src; 96 result = (rtype_name)n + 1; 97 }', `') 98 99SCALAR_ARRAY_FUNCTION(0) 100 101#endif 102