1`/* Implementation of the MINLOC intrinsic 2 Copyright (C) 2002-2020 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 for (n = 0; n < len; n++, src += delta) 46 { 47 if (*src <= minval) 48 { 49 minval = *src; 50 result = (rtype_name)n + 1; 51 break; 52 } 53 } 54#else 55 n = 0; 56#endif 57 if (back) 58 for (; n < len; n++, src += delta) 59 { 60 if (unlikely (*src <= minval)) 61 { 62 minval = *src; 63 result = (rtype_name)n + 1; 64 } 65 } 66 else 67 for (; n < len; n++, src += delta) 68 { 69 if (unlikely (*src < minval)) 70 { 71 minval = *src; 72 result = (rtype_name) n + 1; 73 }') 74 75MASKED_ARRAY_FUNCTION(0, 76` atype_name minval; 77#if defined ('atype_inf`) 78 minval = atype_inf; 79#else 80 minval = atype_max; 81#endif 82#if defined ('atype_nan`) 83 rtype_name result2 = 0; 84#endif 85 result = 0;', 86` if (*msrc) 87 { 88#if defined ('atype_nan`) 89 if (!result2) 90 result2 = (rtype_name)n + 1; 91 if (*src <= minval) 92#endif 93 { 94 minval = *src; 95 result = (rtype_name)n + 1; 96 break; 97 } 98 } 99 } 100#if defined ('atype_nan`) 101 if (unlikely (n >= len)) 102 result = result2; 103 else 104#endif 105 if (back) 106 for (; n < len; n++, src += delta, msrc += mdelta) 107 { 108 if (*msrc && unlikely (*src <= minval)) 109 { 110 minval = *src; 111 result = (rtype_name)n + 1; 112 } 113 } 114 else 115 for (; n < len; n++, src += delta, msrc += mdelta) 116 { 117 if (*msrc && unlikely (*src < minval)) 118 { 119 minval = *src; 120 result = (rtype_name) n + 1; 121 }') 122 123SCALAR_ARRAY_FUNCTION(0) 124 125#endif 126