1251876Speter/* Implementation of the MAXLOC intrinsic 2251876Speter Copyright (C) 2002-2020 Free Software Foundation, Inc. 3251876Speter Contributed by Paul Brook <paul@nowt.org> 4251876Speter 5251876SpeterThis file is part of the GNU Fortran runtime library (libgfortran). 6251876Speter 7251876SpeterLibgfortran is free software; you can redistribute it and/or 8251876Spetermodify it under the terms of the GNU General Public 9251876SpeterLicense as published by the Free Software Foundation; either 10251876Speterversion 3 of the License, or (at your option) any later version. 11251876Speter 12251876SpeterLibgfortran is distributed in the hope that it will be useful, 13251876Speterbut WITHOUT ANY WARRANTY; without even the implied warranty of 14251876SpeterMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15251876SpeterGNU General Public License for more details. 16251876Speter 17251876SpeterUnder Section 7 of GPL version 3, you are granted additional 18251876Speterpermissions described in the GCC Runtime Library Exception, version 19251876Speter3.1, as published by the Free Software Foundation. 20251876Speter 21251876SpeterYou should have received a copy of the GNU General Public License and 22251876Spetera copy of the GCC Runtime Library Exception along with this program; 23251876Spetersee the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24251876Speter<http://www.gnu.org/licenses/>. */ 25251876Speter 26251876Speter#include "libgfortran.h" 27251876Speter#include <assert.h> 28251876Speter 29251876Speter 30251876Speter#if defined (HAVE_GFC_REAL_4) && defined (HAVE_GFC_INTEGER_8) 31251876Speter 32251876Speter#define HAVE_BACK_ARG 1 33251876Speter 34251876Speter 35251876Speterextern void maxloc1_8_r4 (gfc_array_i8 * const restrict, 36251876Speter gfc_array_r4 * const restrict, const index_type * const restrict, GFC_LOGICAL_4 back); 37251876Speterexport_proto(maxloc1_8_r4); 38251876Speter 39251876Spetervoid 40251876Spetermaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, 41251876Speter gfc_array_r4 * const restrict array, 42251876Speter const index_type * const restrict pdim, GFC_LOGICAL_4 back) 43251876Speter{ 44251876Speter index_type count[GFC_MAX_DIMENSIONS]; 45251876Speter index_type extent[GFC_MAX_DIMENSIONS]; 46251876Speter index_type sstride[GFC_MAX_DIMENSIONS]; 47251876Speter index_type dstride[GFC_MAX_DIMENSIONS]; 48251876Speter const GFC_REAL_4 * restrict base; 49251876Speter GFC_INTEGER_8 * restrict dest; 50251876Speter index_type rank; 51251876Speter index_type n; 52251876Speter index_type len; 53251876Speter index_type delta; 54251876Speter index_type dim; 55251876Speter int continue_loop; 56251876Speter 57251876Speter /* Make dim zero based to avoid confusion. */ 58251876Speter rank = GFC_DESCRIPTOR_RANK (array) - 1; 59251876Speter dim = (*pdim) - 1; 60251876Speter 61251876Speter if (unlikely (dim < 0 || dim > rank)) 62251876Speter { 63251876Speter runtime_error ("Dim argument incorrect in MAXLOC intrinsic: " 64251876Speter "is %ld, should be between 1 and %ld", 65251876Speter (long int) dim + 1, (long int) rank + 1); 66251876Speter } 67251876Speter 68251876Speter len = GFC_DESCRIPTOR_EXTENT(array,dim); 69251876Speter if (len < 0) 70251876Speter len = 0; 71251876Speter delta = GFC_DESCRIPTOR_STRIDE(array,dim); 72251876Speter 73251876Speter for (n = 0; n < dim; n++) 74251876Speter { 75251876Speter sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); 76251876Speter extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); 77251876Speter 78251876Speter if (extent[n] < 0) 79251876Speter extent[n] = 0; 80251876Speter } 81251876Speter for (n = dim; n < rank; n++) 82251876Speter { 83251876Speter sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1); 84251876Speter extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); 85251876Speter 86251876Speter if (extent[n] < 0) 87251876Speter extent[n] = 0; 88251876Speter } 89251876Speter 90251876Speter if (retarray->base_addr == NULL) 91251876Speter { 92251876Speter size_t alloc_size, str; 93251876Speter 94251876Speter for (n = 0; n < rank; n++) 95251876Speter { 96251876Speter if (n == 0) 97251876Speter str = 1; 98251876Speter else 99251876Speter str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; 100251876Speter 101251876Speter GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); 102251876Speter 103251876Speter } 104251876Speter 105251876Speter retarray->offset = 0; 106251876Speter retarray->dtype.rank = rank; 107251876Speter 108251876Speter alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; 109251876Speter 110251876Speter retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); 111251876Speter if (alloc_size == 0) 112251876Speter { 113251876Speter /* Make sure we have a zero-sized array. */ 114251876Speter GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); 115251876Speter return; 116251876Speter 117251876Speter } 118251876Speter } 119251876Speter else 120251876Speter { 121251876Speter if (rank != GFC_DESCRIPTOR_RANK (retarray)) 122251876Speter runtime_error ("rank of return array incorrect in" 123251876Speter " MAXLOC intrinsic: is %ld, should be %ld", 124251876Speter (long int) (GFC_DESCRIPTOR_RANK (retarray)), 125251876Speter (long int) rank); 126251876Speter 127251876Speter if (unlikely (compile_options.bounds_check)) 128251876Speter bounds_ifunction_return ((array_t *) retarray, extent, 129251876Speter "return value", "MAXLOC"); 130251876Speter } 131251876Speter 132251876Speter for (n = 0; n < rank; n++) 133251876Speter { 134251876Speter count[n] = 0; 135251876Speter dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); 136251876Speter if (extent[n] <= 0) 137251876Speter return; 138251876Speter } 139251876Speter 140251876Speter base = array->base_addr; 141251876Speter dest = retarray->base_addr; 142251876Speter 143251876Speter continue_loop = 1; 144251876Speter while (continue_loop) 145251876Speter { 146251876Speter const GFC_REAL_4 * restrict src; 147251876Speter GFC_INTEGER_8 result; 148251876Speter src = base; 149251876Speter { 150251876Speter 151251876Speter GFC_REAL_4 maxval; 152251876Speter#if defined (GFC_REAL_4_INFINITY) 153251876Speter maxval = -GFC_REAL_4_INFINITY; 154251876Speter#else 155251876Speter maxval = -GFC_REAL_4_HUGE; 156251876Speter#endif 157251876Speter result = 1; 158251876Speter if (len <= 0) 159251876Speter *dest = 0; 160251876Speter else 161251876Speter { 162251876Speter#if ! defined HAVE_BACK_ARG 163251876Speter for (n = 0; n < len; n++, src += delta) 164251876Speter { 165251876Speter#endif 166251876Speter 167251876Speter#if defined (GFC_REAL_4_QUIET_NAN) 168251876Speter for (n = 0; n < len; n++, src += delta) 169251876Speter { 170251876Speter if (*src >= maxval) 171251876Speter { 172251876Speter maxval = *src; 173251876Speter result = (GFC_INTEGER_8)n + 1; 174251876Speter break; 175251876Speter } 176251876Speter } 177251876Speter#else 178251876Speter n = 0; 179251876Speter#endif 180251876Speter for (; n < len; n++, src += delta) 181251876Speter { 182251876Speter if (back ? *src >= maxval : *src > maxval) 183251876Speter { 184251876Speter maxval = *src; 185251876Speter result = (GFC_INTEGER_8)n + 1; 186251876Speter } 187251876Speter } 188251876Speter 189251876Speter *dest = result; 190251876Speter } 191251876Speter } 192251876Speter /* Advance to the next element. */ 193251876Speter count[0]++; 194251876Speter base += sstride[0]; 195251876Speter dest += dstride[0]; 196251876Speter n = 0; 197251876Speter while (count[n] == extent[n]) 198251876Speter { 199251876Speter /* When we get to the end of a dimension, reset it and increment 200251876Speter the next dimension. */ 201251876Speter count[n] = 0; 202251876Speter /* We could precalculate these products, but this is a less 203251876Speter frequently used path so probably not worth it. */ 204251876Speter base -= sstride[n] * extent[n]; 205251876Speter dest -= dstride[n] * extent[n]; 206251876Speter n++; 207251876Speter if (n >= rank) 208251876Speter { 209251876Speter /* Break out of the loop. */ 210251876Speter continue_loop = 0; 211251876Speter break; 212251876Speter } 213251876Speter else 214251876Speter { 215251876Speter count[n]++; 216251876Speter base += sstride[n]; 217251876Speter dest += dstride[n]; 218251876Speter } 219251876Speter } 220251876Speter } 221251876Speter} 222251876Speter 223251876Speter 224251876Speterextern void mmaxloc1_8_r4 (gfc_array_i8 * const restrict, 225251876Speter gfc_array_r4 * const restrict, const index_type * const restrict, 226251876Speter gfc_array_l1 * const restrict, GFC_LOGICAL_4 back); 227251876Speterexport_proto(mmaxloc1_8_r4); 228251876Speter 229251876Spetervoid 230251876Spetermmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, 231251876Speter gfc_array_r4 * const restrict array, 232251876Speter const index_type * const restrict pdim, 233251876Speter gfc_array_l1 * const restrict mask, GFC_LOGICAL_4 back) 234251876Speter{ 235251876Speter index_type count[GFC_MAX_DIMENSIONS]; 236251876Speter index_type extent[GFC_MAX_DIMENSIONS]; 237251876Speter index_type sstride[GFC_MAX_DIMENSIONS]; 238251876Speter index_type dstride[GFC_MAX_DIMENSIONS]; 239251876Speter index_type mstride[GFC_MAX_DIMENSIONS]; 240251876Speter GFC_INTEGER_8 * restrict dest; 241251876Speter const GFC_REAL_4 * restrict base; 242251876Speter const GFC_LOGICAL_1 * restrict mbase; 243251876Speter index_type rank; 244251876Speter index_type dim; 245251876Speter index_type n; 246251876Speter index_type len; 247251876Speter index_type delta; 248251876Speter index_type mdelta; 249251876Speter int mask_kind; 250251876Speter 251251876Speter if (mask == NULL) 252251876Speter { 253251876Speter#ifdef HAVE_BACK_ARG 254251876Speter maxloc1_8_r4 (retarray, array, pdim, back); 255251876Speter#else 256251876Speter maxloc1_8_r4 (retarray, array, pdim); 257251876Speter#endif 258251876Speter return; 259251876Speter } 260251876Speter 261251876Speter dim = (*pdim) - 1; 262251876Speter rank = GFC_DESCRIPTOR_RANK (array) - 1; 263251876Speter 264251876Speter 265251876Speter if (unlikely (dim < 0 || dim > rank)) 266251876Speter { 267251876Speter runtime_error ("Dim argument incorrect in MAXLOC intrinsic: " 268251876Speter "is %ld, should be between 1 and %ld", 269251876Speter (long int) dim + 1, (long int) rank + 1); 270251876Speter } 271251876Speter 272251876Speter len = GFC_DESCRIPTOR_EXTENT(array,dim); 273251876Speter if (len <= 0) 274251876Speter return; 275251876Speter 276251876Speter mbase = mask->base_addr; 277251876Speter 278251876Speter mask_kind = GFC_DESCRIPTOR_SIZE (mask); 279251876Speter 280251876Speter if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8 281251876Speter#ifdef HAVE_GFC_LOGICAL_16 282251876Speter || mask_kind == 16 283251876Speter#endif 284251876Speter ) 285251876Speter mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind); 286251876Speter else 287251876Speter runtime_error ("Funny sized logical array"); 288251876Speter 289251876Speter delta = GFC_DESCRIPTOR_STRIDE(array,dim); 290251876Speter mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim); 291251876Speter 292251876Speter for (n = 0; n < dim; n++) 293251876Speter { 294251876Speter sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n); 295251876Speter mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); 296251876Speter extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); 297251876Speter 298251876Speter if (extent[n] < 0) 299251876Speter extent[n] = 0; 300251876Speter 301251876Speter } 302251876Speter for (n = dim; n < rank; n++) 303251876Speter { 304251876Speter sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1); 305251876Speter mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1); 306251876Speter extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1); 307251876Speter 308251876Speter if (extent[n] < 0) 309251876Speter extent[n] = 0; 310251876Speter } 311251876Speter 312251876Speter if (retarray->base_addr == NULL) 313251876Speter { 314251876Speter size_t alloc_size, str; 315251876Speter 316251876Speter for (n = 0; n < rank; n++) 317251876Speter { 318251876Speter if (n == 0) 319251876Speter str = 1; 320251876Speter else 321251876Speter str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; 322251876Speter 323251876Speter GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); 324251876Speter 325251876Speter } 326251876Speter 327251876Speter alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; 328251876Speter 329251876Speter retarray->offset = 0; 330251876Speter retarray->dtype.rank = rank; 331251876Speter 332251876Speter if (alloc_size == 0) 333251876Speter { 334251876Speter /* Make sure we have a zero-sized array. */ 335251876Speter GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); 336251876Speter return; 337251876Speter } 338251876Speter else 339251876Speter retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); 340251876Speter 341251876Speter } 342251876Speter else 343251876Speter { 344251876Speter if (rank != GFC_DESCRIPTOR_RANK (retarray)) 345251876Speter runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); 346251876Speter 347251876Speter if (unlikely (compile_options.bounds_check)) 348251876Speter { 349251876Speter bounds_ifunction_return ((array_t *) retarray, extent, 350251876Speter "return value", "MAXLOC"); 351251876Speter bounds_equal_extents ((array_t *) mask, (array_t *) array, 352251876Speter "MASK argument", "MAXLOC"); 353251876Speter } 354251876Speter } 355251876Speter 356251876Speter for (n = 0; n < rank; n++) 357251876Speter { 358251876Speter count[n] = 0; 359251876Speter dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); 360251876Speter if (extent[n] <= 0) 361251876Speter return; 362251876Speter } 363251876Speter 364251876Speter dest = retarray->base_addr; 365251876Speter base = array->base_addr; 366251876Speter 367251876Speter while (base) 368251876Speter { 369251876Speter const GFC_REAL_4 * restrict src; 370251876Speter const GFC_LOGICAL_1 * restrict msrc; 371251876Speter GFC_INTEGER_8 result; 372251876Speter src = base; 373251876Speter msrc = mbase; 374251876Speter { 375251876Speter 376251876Speter GFC_REAL_4 maxval; 377251876Speter#if defined (GFC_REAL_4_INFINITY) 378251876Speter maxval = -GFC_REAL_4_INFINITY; 379251876Speter#else 380251876Speter maxval = -GFC_REAL_4_HUGE; 381251876Speter#endif 382251876Speter#if defined (GFC_REAL_4_QUIET_NAN) 383251876Speter GFC_INTEGER_8 result2 = 0; 384251876Speter#endif 385251876Speter result = 0; 386251876Speter for (n = 0; n < len; n++, src += delta, msrc += mdelta) 387251876Speter { 388251876Speter 389251876Speter if (*msrc) 390251876Speter { 391251876Speter#if defined (GFC_REAL_4_QUIET_NAN) 392251876Speter if (!result2) 393251876Speter result2 = (GFC_INTEGER_8)n + 1; 394251876Speter if (*src >= maxval) 395251876Speter#endif 396251876Speter { 397251876Speter maxval = *src; 398251876Speter result = (GFC_INTEGER_8)n + 1; 399251876Speter break; 400251876Speter } 401251876Speter } 402251876Speter } 403251876Speter#if defined (GFC_REAL_4_QUIET_NAN) 404251876Speter if (unlikely (n >= len)) 405251876Speter result = result2; 406251876Speter else 407251876Speter#endif 408251876Speter if (back) 409251876Speter for (; n < len; n++, src += delta, msrc += mdelta) 410251876Speter { 411251876Speter if (*msrc && unlikely (*src >= maxval)) 412251876Speter { 413251876Speter maxval = *src; 414251876Speter result = (GFC_INTEGER_8)n + 1; 415251876Speter } 416251876Speter } 417251876Speter else 418251876Speter for (; n < len; n++, src += delta, msrc += mdelta) 419251876Speter { 420251876Speter if (*msrc && unlikely (*src > maxval)) 421251876Speter { 422251876Speter maxval = *src; 423251876Speter result = (GFC_INTEGER_8)n + 1; 424251876Speter } 425251876Speter } 426251876Speter *dest = result; 427251876Speter } 428251876Speter /* Advance to the next element. */ 429251876Speter count[0]++; 430251876Speter base += sstride[0]; 431251876Speter mbase += mstride[0]; 432251876Speter dest += dstride[0]; 433251876Speter n = 0; 434251876Speter while (count[n] == extent[n]) 435251876Speter { 436251876Speter /* When we get to the end of a dimension, reset it and increment 437251876Speter the next dimension. */ 438251876Speter count[n] = 0; 439251876Speter /* We could precalculate these products, but this is a less 440251876Speter frequently used path so probably not worth it. */ 441251876Speter base -= sstride[n] * extent[n]; 442251876Speter mbase -= mstride[n] * extent[n]; 443251876Speter dest -= dstride[n] * extent[n]; 444251876Speter n++; 445251876Speter if (n >= rank) 446251876Speter { 447251876Speter /* Break out of the loop. */ 448251876Speter base = NULL; 449251876Speter break; 450251876Speter } 451251876Speter else 452251876Speter { 453251876Speter count[n]++; 454251876Speter base += sstride[n]; 455251876Speter mbase += mstride[n]; 456251876Speter dest += dstride[n]; 457251876Speter } 458251876Speter } 459251876Speter } 460251876Speter} 461251876Speter 462251876Speter 463251876Speterextern void smaxloc1_8_r4 (gfc_array_i8 * const restrict, 464251876Speter gfc_array_r4 * const restrict, const index_type * const restrict, 465251876Speter GFC_LOGICAL_4 *, GFC_LOGICAL_4 back); 466251876Speterexport_proto(smaxloc1_8_r4); 467251876Speter 468251876Spetervoid 469251876Spetersmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, 470251876Speter gfc_array_r4 * const restrict array, 471251876Speter const index_type * const restrict pdim, 472251876Speter GFC_LOGICAL_4 * mask, GFC_LOGICAL_4 back) 473251876Speter{ 474251876Speter index_type count[GFC_MAX_DIMENSIONS]; 475251876Speter index_type extent[GFC_MAX_DIMENSIONS]; 476251876Speter index_type dstride[GFC_MAX_DIMENSIONS]; 477251876Speter GFC_INTEGER_8 * restrict dest; 478251876Speter index_type rank; 479251876Speter index_type n; 480251876Speter index_type dim; 481251876Speter 482251876Speter 483251876Speter if (mask == NULL || *mask) 484251876Speter { 485251876Speter#ifdef HAVE_BACK_ARG 486251876Speter maxloc1_8_r4 (retarray, array, pdim, back); 487251876Speter#else 488251876Speter maxloc1_8_r4 (retarray, array, pdim); 489251876Speter#endif 490251876Speter return; 491251876Speter } 492251876Speter /* Make dim zero based to avoid confusion. */ 493251876Speter dim = (*pdim) - 1; 494251876Speter rank = GFC_DESCRIPTOR_RANK (array) - 1; 495251876Speter 496251876Speter if (unlikely (dim < 0 || dim > rank)) 497251876Speter { 498251876Speter runtime_error ("Dim argument incorrect in MAXLOC intrinsic: " 499251876Speter "is %ld, should be between 1 and %ld", 500251876Speter (long int) dim + 1, (long int) rank + 1); 501251876Speter } 502251876Speter 503251876Speter for (n = 0; n < dim; n++) 504251876Speter { 505251876Speter extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); 506251876Speter 507251876Speter if (extent[n] <= 0) 508251876Speter extent[n] = 0; 509251876Speter } 510251876Speter 511251876Speter for (n = dim; n < rank; n++) 512251876Speter { 513251876Speter extent[n] = 514251876Speter GFC_DESCRIPTOR_EXTENT(array,n + 1); 515251876Speter 516251876Speter if (extent[n] <= 0) 517251876Speter extent[n] = 0; 518251876Speter } 519251876Speter 520251876Speter if (retarray->base_addr == NULL) 521251876Speter { 522251876Speter size_t alloc_size, str; 523251876Speter 524251876Speter for (n = 0; n < rank; n++) 525251876Speter { 526251876Speter if (n == 0) 527251876Speter str = 1; 528251876Speter else 529251876Speter str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1]; 530251876Speter 531251876Speter GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str); 532251876Speter 533251876Speter } 534251876Speter 535251876Speter retarray->offset = 0; 536251876Speter retarray->dtype.rank = rank; 537251876Speter 538251876Speter alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) * extent[rank-1]; 539251876Speter 540251876Speter if (alloc_size == 0) 541251876Speter { 542251876Speter /* Make sure we have a zero-sized array. */ 543251876Speter GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1); 544251876Speter return; 545251876Speter } 546251876Speter else 547251876Speter retarray->base_addr = xmallocarray (alloc_size, sizeof (GFC_INTEGER_8)); 548251876Speter } 549251876Speter else 550251876Speter { 551251876Speter if (rank != GFC_DESCRIPTOR_RANK (retarray)) 552251876Speter runtime_error ("rank of return array incorrect in" 553251876Speter " MAXLOC intrinsic: is %ld, should be %ld", 554251876Speter (long int) (GFC_DESCRIPTOR_RANK (retarray)), 555251876Speter (long int) rank); 556251876Speter 557251876Speter if (unlikely (compile_options.bounds_check)) 558251876Speter { 559251876Speter for (n=0; n < rank; n++) 560251876Speter { 561251876Speter index_type ret_extent; 562251876Speter 563251876Speter ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); 564251876Speter if (extent[n] != ret_extent) 565251876Speter runtime_error ("Incorrect extent in return value of" 566251876Speter " MAXLOC intrinsic in dimension %ld:" 567251876Speter " is %ld, should be %ld", (long int) n + 1, 568251876Speter (long int) ret_extent, (long int) extent[n]); 569251876Speter } 570251876Speter } 571251876Speter } 572251876Speter 573251876Speter for (n = 0; n < rank; n++) 574251876Speter { 575251876Speter count[n] = 0; 576251876Speter dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n); 577251876Speter } 578251876Speter 579251876Speter dest = retarray->base_addr; 580251876Speter 581251876Speter while(1) 582251876Speter { 583251876Speter *dest = 0; 584251876Speter count[0]++; 585251876Speter dest += dstride[0]; 586251876Speter n = 0; 587251876Speter while (count[n] == extent[n]) 588251876Speter { 589251876Speter /* When we get to the end of a dimension, reset it and increment 590251876Speter the next dimension. */ 591251876Speter count[n] = 0; 592251876Speter /* We could precalculate these products, but this is a less 593251876Speter frequently used path so probably not worth it. */ 594251876Speter dest -= dstride[n] * extent[n]; 595251876Speter n++; 596251876Speter if (n >= rank) 597251876Speter return; 598251876Speter else 599251876Speter { 600251876Speter count[n]++; 601251876Speter dest += dstride[n]; 602251876Speter } 603251876Speter } 604251876Speter } 605251876Speter} 606251876Speter 607251876Speter#endif 608251876Speter