1`/* Implementation of the MAXLOC 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 95 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(iforeach.m4)dnl
31
32`#if defined (HAVE_'atype_name`) && defined (HAVE_'rtype_name`)'
33
34FOREACH_FUNCTION(
35`    atype_name maxval;
36#if defined('atype_nan`)
37    int fast = 0;
38#endif
39
40#if defined('atype_inf`)
41    maxval = -atype_inf;
42#else
43    maxval = atype_min;
44#endif',
45`#if defined('atype_nan`)
46      if (unlikely (!fast))
47	{
48	  do
49	    {
50	      if (*base >= maxval)
51		{
52		  fast = 1;
53		  maxval = *base;
54		  for (n = 0; n < rank; n++)
55		    dest[n * dstride] = count[n] + 1;
56		  break;
57		}
58	      base += sstride[0];
59	    }
60	  while (++count[0] != extent[0]);
61	  if (likely (fast))
62	    continue;
63	}
64      else
65#endif
66        if (back)
67      	  do
68            {
69	      if (unlikely (*base >= maxval))
70	       {
71	         maxval = *base;
72	      	 for (n = 0; n < rank; n++)
73		   dest[n * dstride] = count[n] + 1;
74	       }
75	     base += sstride[0];
76	   }
77         while (++count[0] != extent[0]);
78       else
79         do
80	   {
81	     if (unlikely (*base > maxval))
82	       {
83	         maxval = *base;
84		 for (n = 0; n < rank; n++)
85		   dest[n * dstride] = count[n] + 1;
86	       }')
87MASKED_FOREACH_FUNCTION(
88`  atype_name maxval;
89   int fast = 0;
90
91#if defined('atype_inf`)
92    maxval = -atype_inf;
93#else
94    maxval = atype_min;
95#endif',
96`      if (unlikely (!fast))
97	{
98	  do
99	    {
100	      if (*mbase)
101		{
102#if defined('atype_nan`)
103		  if (unlikely (dest[0] == 0))
104		    for (n = 0; n < rank; n++)
105		      dest[n * dstride] = count[n] + 1;
106		  if (*base >= maxval)
107#endif
108		    {
109		      fast = 1;
110		      maxval = *base;
111		      for (n = 0; n < rank; n++)
112			dest[n * dstride] = count[n] + 1;
113		      break;
114		    }
115		}
116	      base += sstride[0];
117	      mbase += mstride[0];
118	    }
119	  while (++count[0] != extent[0]);
120	  if (likely (fast))
121	    continue;
122	}
123      else
124        if (back)
125	  do
126	    {
127	      if (*mbase && *base >= maxval)
128	        {
129	          maxval = *base;
130	          for (n = 0; n < rank; n++)
131		    dest[n * dstride] = count[n] + 1;
132		}
133	      base += sstride[0];
134	    }
135	  while (++count[0] != extent[0]);
136	else
137	  do
138	    {
139	      if (*mbase && unlikely (*base > maxval))
140	        {
141		  maxval = *base;
142		  for (n = 0; n < rank; n++)
143		    dest[n * dstride] = count[n] + 1;
144	        }')
145
146SCALAR_FOREACH_FUNCTION(`0')
147#endif
148