1 //===-- runtime/transformational.cpp --------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 // Implements the transformational intrinsic functions of Fortran 2018 that
10 // rearrange or duplicate data without (much) regard to type.  These are
11 // CSHIFT, EOSHIFT, PACK, RESHAPE, SPREAD, TRANSPOSE, and UNPACK.
12 //
13 // Many of these are defined in the 2018 standard with text that makes sense
14 // only if argument arrays have lower bounds of one.  Rather than interpret
15 // these cases as implying a hidden constraint, these implementations
16 // work with arbitrary lower bounds.  This may be technically an extension
17 // of the standard but it more likely to conform with its intent.
18 
19 #include "transformational.h"
20 #include "copy.h"
21 #include "terminator.h"
22 #include "tools.h"
23 #include <algorithm>
24 
25 namespace Fortran::runtime {
26 
27 // Utility for CSHIFT & EOSHIFT rank > 1 cases that determines the shift count
28 // for each of the vector sections of the result.
29 class ShiftControl {
30 public:
31   ShiftControl(const Descriptor &s, Terminator &t, int dim)
32       : shift_{s}, terminator_{t}, shiftRank_{s.rank()}, dim_{dim} {}
33   void Init(const Descriptor &source) {
34     int rank{source.rank()};
35     RUNTIME_CHECK(terminator_, shiftRank_ == 0 || shiftRank_ == rank - 1);
36     auto catAndKind{shift_.type().GetCategoryAndKind()};
37     RUNTIME_CHECK(
38         terminator_, catAndKind && catAndKind->first == TypeCategory::Integer);
39     shiftElemLen_ = catAndKind->second;
40     if (shiftRank_ > 0) {
41       int k{0};
42       for (int j{0}; j < rank; ++j) {
43         if (j + 1 != dim_) {
44           const Dimension &shiftDim{shift_.GetDimension(k)};
45           lb_[k++] = shiftDim.LowerBound();
46           RUNTIME_CHECK(terminator_,
47               shiftDim.Extent() == source.GetDimension(j).Extent());
48         }
49       }
50     } else {
51       shiftCount_ =
52           GetInt64(shift_.OffsetElement<char>(), shiftElemLen_, terminator_);
53     }
54   }
55   SubscriptValue GetShift(const SubscriptValue resultAt[]) const {
56     if (shiftRank_ > 0) {
57       SubscriptValue shiftAt[maxRank];
58       int k{0};
59       for (int j{0}; j < shiftRank_ + 1; ++j) {
60         if (j + 1 != dim_) {
61           shiftAt[k] = lb_[k] + resultAt[j] - 1;
62           ++k;
63         }
64       }
65       return GetInt64(
66           shift_.Element<char>(shiftAt), shiftElemLen_, terminator_);
67     } else {
68       return shiftCount_; // invariant count extracted in Init()
69     }
70   }
71 
72 private:
73   const Descriptor &shift_;
74   Terminator &terminator_;
75   int shiftRank_;
76   int dim_;
77   SubscriptValue lb_[maxRank];
78   std::size_t shiftElemLen_;
79   SubscriptValue shiftCount_{};
80 };
81 
82 // Fill an EOSHIFT result with default boundary values
83 static void DefaultInitialize(
84     const Descriptor &result, Terminator &terminator) {
85   auto catAndKind{result.type().GetCategoryAndKind()};
86   RUNTIME_CHECK(
87       terminator, catAndKind && catAndKind->first != TypeCategory::Derived);
88   std::size_t elementLen{result.ElementBytes()};
89   std::size_t bytes{result.Elements() * elementLen};
90   if (catAndKind->first == TypeCategory::Character) {
91     switch (int kind{catAndKind->second}) {
92     case 1:
93       std::fill_n(result.OffsetElement<char>(), bytes, ' ');
94       break;
95     case 2:
96       std::fill_n(result.OffsetElement<char16_t>(), bytes / 2,
97           static_cast<char16_t>(' '));
98       break;
99     case 4:
100       std::fill_n(result.OffsetElement<char32_t>(), bytes / 4,
101           static_cast<char32_t>(' '));
102       break;
103     default:
104       terminator.Crash("EOSHIFT: bad CHARACTER kind %d", kind);
105     }
106   } else {
107     std::memset(result.raw().base_addr, 0, bytes);
108   }
109 }
110 
111 static inline std::size_t AllocateResult(Descriptor &result,
112     const Descriptor &source, int rank, const SubscriptValue extent[],
113     Terminator &terminator, const char *function) {
114   std::size_t elementLen{source.ElementBytes()};
115   const DescriptorAddendum *sourceAddendum{source.Addendum()};
116   result.Establish(source.type(), elementLen, nullptr, rank, extent,
117       CFI_attribute_allocatable, sourceAddendum != nullptr);
118   if (sourceAddendum) {
119     *result.Addendum() = *sourceAddendum;
120   }
121   for (int j{0}; j < rank; ++j) {
122     result.GetDimension(j).SetBounds(1, extent[j]);
123   }
124   if (int stat{result.Allocate()}) {
125     terminator.Crash(
126         "%s: Could not allocate memory for result (stat=%d)", function, stat);
127   }
128   return elementLen;
129 }
130 
131 extern "C" {
132 
133 // CSHIFT of rank > 1
134 void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
135     const Descriptor &shift, int dim, const char *sourceFile, int line) {
136   Terminator terminator{sourceFile, line};
137   int rank{source.rank()};
138   RUNTIME_CHECK(terminator, rank > 1);
139   RUNTIME_CHECK(terminator, dim >= 1 && dim <= rank);
140   ShiftControl shiftControl{shift, terminator, dim};
141   shiftControl.Init(source);
142   SubscriptValue extent[maxRank];
143   source.GetShape(extent);
144   AllocateResult(result, source, rank, extent, terminator, "CSHIFT");
145   SubscriptValue resultAt[maxRank];
146   for (int j{0}; j < rank; ++j) {
147     resultAt[j] = 1;
148   }
149   SubscriptValue sourceLB[maxRank];
150   source.GetLowerBounds(sourceLB);
151   SubscriptValue dimExtent{extent[dim - 1]};
152   SubscriptValue dimLB{sourceLB[dim - 1]};
153   SubscriptValue &resDim{resultAt[dim - 1]};
154   for (std::size_t n{result.Elements()}; n > 0; n -= dimExtent) {
155     SubscriptValue shiftCount{shiftControl.GetShift(resultAt)};
156     SubscriptValue sourceAt[maxRank];
157     for (int j{0}; j < rank; ++j) {
158       sourceAt[j] = sourceLB[j] + resultAt[j] - 1;
159     }
160     SubscriptValue &sourceDim{sourceAt[dim - 1]};
161     sourceDim = dimLB + shiftCount % dimExtent;
162     if (shiftCount < 0) {
163       sourceDim += dimExtent;
164     }
165     for (resDim = 1; resDim <= dimExtent; ++resDim) {
166       CopyElement(result, resultAt, source, sourceAt, terminator);
167       if (++sourceDim == dimLB + dimExtent) {
168         sourceDim = dimLB;
169       }
170     }
171     result.IncrementSubscripts(resultAt);
172   }
173 }
174 
175 // CSHIFT of vector
176 void RTNAME(CshiftVector)(Descriptor &result, const Descriptor &source,
177     std::int64_t shift, const char *sourceFile, int line) {
178   Terminator terminator{sourceFile, line};
179   RUNTIME_CHECK(terminator, source.rank() == 1);
180   const Dimension &sourceDim{source.GetDimension(0)};
181   SubscriptValue extent{sourceDim.Extent()};
182   AllocateResult(result, source, 1, &extent, terminator, "CSHIFT");
183   SubscriptValue lb{sourceDim.LowerBound()};
184   for (SubscriptValue j{0}; j < extent; ++j) {
185     SubscriptValue resultAt{1 + j};
186     SubscriptValue sourceAt{lb + (j + shift) % extent};
187     CopyElement(result, &resultAt, source, &sourceAt, terminator);
188   }
189 }
190 
191 // EOSHIFT of rank > 1
192 void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
193     const Descriptor &shift, const Descriptor *boundary, int dim,
194     const char *sourceFile, int line) {
195   Terminator terminator{sourceFile, line};
196   SubscriptValue extent[maxRank];
197   int rank{source.GetShape(extent)};
198   RUNTIME_CHECK(terminator, rank > 1);
199   RUNTIME_CHECK(terminator, dim >= 1 && dim <= rank);
200   std::size_t elementLen{
201       AllocateResult(result, source, rank, extent, terminator, "EOSHIFT")};
202   int boundaryRank{-1};
203   if (boundary) {
204     boundaryRank = boundary->rank();
205     RUNTIME_CHECK(terminator, boundaryRank == 0 || boundaryRank == rank - 1);
206     RUNTIME_CHECK(terminator,
207         boundary->type() == source.type() &&
208             boundary->ElementBytes() == elementLen);
209     if (boundaryRank > 0) {
210       int k{0};
211       for (int j{0}; j < rank; ++j) {
212         if (j != dim - 1) {
213           RUNTIME_CHECK(
214               terminator, boundary->GetDimension(k).Extent() == extent[j]);
215           ++k;
216         }
217       }
218     }
219   }
220   ShiftControl shiftControl{shift, terminator, dim};
221   shiftControl.Init(source);
222   SubscriptValue resultAt[maxRank];
223   for (int j{0}; j < rank; ++j) {
224     resultAt[j] = 1;
225   }
226   if (!boundary) {
227     DefaultInitialize(result, terminator);
228   }
229   SubscriptValue sourceLB[maxRank];
230   source.GetLowerBounds(sourceLB);
231   SubscriptValue boundaryAt[maxRank];
232   if (boundaryRank > 0) {
233     boundary->GetLowerBounds(boundaryAt);
234   }
235   SubscriptValue dimExtent{extent[dim - 1]};
236   SubscriptValue dimLB{sourceLB[dim - 1]};
237   SubscriptValue &resDim{resultAt[dim - 1]};
238   for (std::size_t n{result.Elements()}; n > 0; n -= dimExtent) {
239     SubscriptValue shiftCount{shiftControl.GetShift(resultAt)};
240     SubscriptValue sourceAt[maxRank];
241     for (int j{0}; j < rank; ++j) {
242       sourceAt[j] = sourceLB[j] + resultAt[j] - 1;
243     }
244     SubscriptValue &sourceDim{sourceAt[dim - 1]};
245     sourceDim = dimLB + shiftCount;
246     for (resDim = 1; resDim <= dimExtent; ++resDim) {
247       if (sourceDim >= dimLB && sourceDim < dimLB + dimExtent) {
248         CopyElement(result, resultAt, source, sourceAt, terminator);
249       } else if (boundary) {
250         CopyElement(result, resultAt, *boundary, boundaryAt, terminator);
251       }
252       ++sourceDim;
253     }
254     result.IncrementSubscripts(resultAt);
255     if (boundaryRank > 0) {
256       boundary->IncrementSubscripts(boundaryAt);
257     }
258   }
259 }
260 
261 // EOSHIFT of vector
262 void RTNAME(EoshiftVector)(Descriptor &result, const Descriptor &source,
263     std::int64_t shift, const Descriptor *boundary, const char *sourceFile,
264     int line) {
265   Terminator terminator{sourceFile, line};
266   RUNTIME_CHECK(terminator, source.rank() == 1);
267   SubscriptValue extent{source.GetDimension(0).Extent()};
268   std::size_t elementLen{
269       AllocateResult(result, source, 1, &extent, terminator, "EOSHIFT")};
270   if (boundary) {
271     RUNTIME_CHECK(terminator, boundary->rank() == 0);
272     RUNTIME_CHECK(terminator,
273         boundary->type() == source.type() &&
274             boundary->ElementBytes() == elementLen);
275   }
276   if (!boundary) {
277     DefaultInitialize(result, terminator);
278   }
279   SubscriptValue lb{source.GetDimension(0).LowerBound()};
280   for (SubscriptValue j{1}; j <= extent; ++j) {
281     SubscriptValue sourceAt{lb + j - 1 + shift};
282     if (sourceAt >= lb && sourceAt < lb + extent) {
283       CopyElement(result, &j, source, &sourceAt, terminator);
284     }
285   }
286 }
287 
288 // PACK
289 void RTNAME(Pack)(Descriptor &result, const Descriptor &source,
290     const Descriptor &mask, const Descriptor *vector, const char *sourceFile,
291     int line) {
292   Terminator terminator{sourceFile, line};
293   CheckConformability(source, mask, terminator, "PACK", "ARRAY=", "MASK=");
294   auto maskType{mask.type().GetCategoryAndKind()};
295   RUNTIME_CHECK(
296       terminator, maskType && maskType->first == TypeCategory::Logical);
297   SubscriptValue trues{0};
298   if (mask.rank() == 0) {
299     if (IsLogicalElementTrue(mask, nullptr)) {
300       trues = source.Elements();
301     }
302   } else {
303     SubscriptValue maskAt[maxRank];
304     mask.GetLowerBounds(maskAt);
305     for (std::size_t n{mask.Elements()}; n > 0; --n) {
306       if (IsLogicalElementTrue(mask, maskAt)) {
307         ++trues;
308       }
309       mask.IncrementSubscripts(maskAt);
310     }
311   }
312   SubscriptValue extent{trues};
313   if (vector) {
314     RUNTIME_CHECK(terminator, vector->rank() == 1);
315     RUNTIME_CHECK(terminator,
316         source.type() == vector->type() &&
317             source.ElementBytes() == vector->ElementBytes());
318     extent = vector->GetDimension(0).Extent();
319     RUNTIME_CHECK(terminator, extent >= trues);
320   }
321   AllocateResult(result, source, 1, &extent, terminator, "PACK");
322   SubscriptValue sourceAt[maxRank], resultAt{1};
323   source.GetLowerBounds(sourceAt);
324   if (mask.rank() == 0) {
325     if (IsLogicalElementTrue(mask, nullptr)) {
326       for (SubscriptValue n{trues}; n > 0; --n) {
327         CopyElement(result, &resultAt, source, sourceAt, terminator);
328         ++resultAt;
329         source.IncrementSubscripts(sourceAt);
330       }
331     }
332   } else {
333     SubscriptValue maskAt[maxRank];
334     mask.GetLowerBounds(maskAt);
335     for (std::size_t n{source.Elements()}; n > 0; --n) {
336       if (IsLogicalElementTrue(mask, maskAt)) {
337         CopyElement(result, &resultAt, source, sourceAt, terminator);
338         ++resultAt;
339       }
340       source.IncrementSubscripts(sourceAt);
341       mask.IncrementSubscripts(maskAt);
342     }
343   }
344   if (vector) {
345     SubscriptValue vectorAt{
346         vector->GetDimension(0).LowerBound() + resultAt - 1};
347     for (; resultAt <= extent; ++resultAt, ++vectorAt) {
348       CopyElement(result, &resultAt, *vector, &vectorAt, terminator);
349     }
350   }
351 }
352 
353 } // extern "C" - TODO put Reshape under extern "C"
354 // F2018 16.9.163
355 OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
356     const Descriptor &shape, const Descriptor *pad, const Descriptor *order,
357     const char *sourceFile, int line) {
358   // Compute and check the rank of the result.
359   Terminator terminator{sourceFile, line};
360   RUNTIME_CHECK(terminator, shape.rank() == 1);
361   RUNTIME_CHECK(terminator, shape.type().IsInteger());
362   SubscriptValue resultRank{shape.GetDimension(0).Extent()};
363   RUNTIME_CHECK(terminator,
364       resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
365 
366   // Extract and check the shape of the result; compute its element count.
367   SubscriptValue resultExtent[maxRank];
368   std::size_t shapeElementBytes{shape.ElementBytes()};
369   std::size_t resultElements{1};
370   SubscriptValue shapeSubscript{shape.GetDimension(0).LowerBound()};
371   for (SubscriptValue j{0}; j < resultRank; ++j, ++shapeSubscript) {
372     resultExtent[j] = GetInt64(
373         shape.Element<char>(&shapeSubscript), shapeElementBytes, terminator);
374     RUNTIME_CHECK(terminator, resultExtent[j] >= 0);
375     resultElements *= resultExtent[j];
376   }
377 
378   // Check that there are sufficient elements in the SOURCE=, or that
379   // the optional PAD= argument is present and nonempty.
380   std::size_t elementBytes{source.ElementBytes()};
381   std::size_t sourceElements{source.Elements()};
382   std::size_t padElements{pad ? pad->Elements() : 0};
383   if (resultElements < sourceElements) {
384     RUNTIME_CHECK(terminator, padElements > 0);
385     RUNTIME_CHECK(terminator, pad->ElementBytes() == elementBytes);
386   }
387 
388   // Extract and check the optional ORDER= argument, which must be a
389   // permutation of [1..resultRank].
390   int dimOrder[maxRank];
391   if (order) {
392     RUNTIME_CHECK(terminator, order->rank() == 1);
393     RUNTIME_CHECK(terminator, order->type().IsInteger());
394     RUNTIME_CHECK(terminator, order->GetDimension(0).Extent() == resultRank);
395     std::uint64_t values{0};
396     SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()};
397     for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) {
398       auto k{GetInt64(order->OffsetElement<char>(orderSubscript),
399           shapeElementBytes, terminator)};
400       RUNTIME_CHECK(
401           terminator, k >= 1 && k <= resultRank && !((values >> k) & 1));
402       values |= std::uint64_t{1} << k;
403       dimOrder[k - 1] = j;
404     }
405   } else {
406     for (int j{0}; j < resultRank; ++j) {
407       dimOrder[j] = j;
408     }
409   }
410 
411   // Create and populate the result's descriptor.
412   const DescriptorAddendum *sourceAddendum{source.Addendum()};
413   const typeInfo::DerivedType *sourceDerivedType{
414       sourceAddendum ? sourceAddendum->derivedType() : nullptr};
415   OwningPtr<Descriptor> result;
416   if (sourceDerivedType) {
417     result = Descriptor::Create(*sourceDerivedType, nullptr, resultRank,
418         resultExtent, CFI_attribute_allocatable);
419   } else {
420     result = Descriptor::Create(source.type(), elementBytes, nullptr,
421         resultRank, resultExtent,
422         CFI_attribute_allocatable); // TODO rearrange these arguments
423   }
424   DescriptorAddendum *resultAddendum{result->Addendum()};
425   RUNTIME_CHECK(terminator, resultAddendum);
426   resultAddendum->flags() |= DescriptorAddendum::DoNotFinalize;
427   if (sourceDerivedType) {
428     std::size_t lenParameters{sourceAddendum->LenParameters()};
429     for (std::size_t j{0}; j < lenParameters; ++j) {
430       resultAddendum->SetLenParameterValue(
431           j, sourceAddendum->LenParameterValue(j));
432     }
433   }
434   // Allocate storage for the result's data.
435   for (int j{0}; j < resultRank; ++j) {
436     result->GetDimension(j).SetBounds(1, resultExtent[j]);
437   }
438   int status{result->Allocate()};
439   if (status != CFI_SUCCESS) {
440     terminator.Crash("RESHAPE: Allocate failed (error %d)", status);
441   }
442 
443   // Populate the result's elements.
444   SubscriptValue resultSubscript[maxRank];
445   result->GetLowerBounds(resultSubscript);
446   SubscriptValue sourceSubscript[maxRank];
447   source.GetLowerBounds(sourceSubscript);
448   std::size_t resultElement{0};
449   std::size_t elementsFromSource{std::min(resultElements, sourceElements)};
450   for (; resultElement < elementsFromSource; ++resultElement) {
451     CopyElement(*result, resultSubscript, source, sourceSubscript, terminator);
452     source.IncrementSubscripts(sourceSubscript);
453     result->IncrementSubscripts(resultSubscript, dimOrder);
454   }
455   if (resultElement < resultElements) {
456     // Remaining elements come from the optional PAD= argument.
457     SubscriptValue padSubscript[maxRank];
458     pad->GetLowerBounds(padSubscript);
459     for (; resultElement < resultElements; ++resultElement) {
460       CopyElement(*result, resultSubscript, *pad, padSubscript, terminator);
461       pad->IncrementSubscripts(padSubscript);
462       result->IncrementSubscripts(resultSubscript, dimOrder);
463     }
464   }
465 
466   return result;
467 }
468 extern "C" { // TODO - remove when Reshape is under extern "C"
469 
470 // SPREAD
471 void RTNAME(Spread)(Descriptor &result, const Descriptor &source, int dim,
472     std::int64_t ncopies, const char *sourceFile, int line) {
473   Terminator terminator{sourceFile, line};
474   int rank{source.rank() + 1};
475   RUNTIME_CHECK(terminator, rank <= maxRank);
476   ncopies = std::max<std::int64_t>(ncopies, 0);
477   SubscriptValue extent[maxRank];
478   int k{0};
479   for (int j{0}; j < rank; ++j) {
480     extent[j] = j == dim - 1 ? ncopies : source.GetDimension(k++).Extent();
481   }
482   AllocateResult(result, source, rank, extent, terminator, "SPREAD");
483   SubscriptValue resultAt[maxRank];
484   for (int j{0}; j < rank; ++j) {
485     resultAt[j] = 1;
486   }
487   SubscriptValue &resultDim{resultAt[dim - 1]};
488   SubscriptValue sourceAt[maxRank];
489   source.GetLowerBounds(sourceAt);
490   for (std::size_t n{result.Elements()}; n > 0; n -= ncopies) {
491     for (resultDim = 1; resultDim <= ncopies; ++resultDim) {
492       CopyElement(result, resultAt, source, sourceAt, terminator);
493     }
494     result.IncrementSubscripts(resultAt);
495     source.IncrementSubscripts(sourceAt);
496   }
497 }
498 
499 // TRANSPOSE
500 void RTNAME(Transpose)(Descriptor &result, const Descriptor &matrix,
501     const char *sourceFile, int line) {
502   Terminator terminator{sourceFile, line};
503   RUNTIME_CHECK(terminator, matrix.rank() == 2);
504   SubscriptValue extent[2]{
505       matrix.GetDimension(1).Extent(), matrix.GetDimension(0).Extent()};
506   AllocateResult(result, matrix, 2, extent, terminator, "TRANSPOSE");
507   SubscriptValue resultAt[2]{1, 1};
508   SubscriptValue matrixLB[2];
509   matrix.GetLowerBounds(matrixLB);
510   for (std::size_t n{result.Elements()}; n-- > 0;
511        result.IncrementSubscripts(resultAt)) {
512     SubscriptValue matrixAt[2]{
513         matrixLB[0] + resultAt[1] - 1, matrixLB[1] + resultAt[0] - 1};
514     CopyElement(result, resultAt, matrix, matrixAt, terminator);
515   }
516 }
517 
518 // UNPACK
519 void RTNAME(Unpack)(Descriptor &result, const Descriptor &vector,
520     const Descriptor &mask, const Descriptor &field, const char *sourceFile,
521     int line) {
522   Terminator terminator{sourceFile, line};
523   RUNTIME_CHECK(terminator, vector.rank() == 1);
524   int rank{mask.rank()};
525   RUNTIME_CHECK(terminator, rank > 0);
526   SubscriptValue extent[maxRank];
527   mask.GetShape(extent);
528   CheckConformability(mask, field, terminator, "UNPACK", "MASK=", "FIELD=");
529   std::size_t elementLen{
530       AllocateResult(result, field, rank, extent, terminator, "UNPACK")};
531   RUNTIME_CHECK(terminator,
532       vector.type() == field.type() && vector.ElementBytes() == elementLen);
533   SubscriptValue resultAt[maxRank], maskAt[maxRank], fieldAt[maxRank],
534       vectorAt{vector.GetDimension(0).LowerBound()};
535   for (int j{0}; j < rank; ++j) {
536     resultAt[j] = 1;
537   }
538   mask.GetLowerBounds(maskAt);
539   field.GetLowerBounds(fieldAt);
540   SubscriptValue vectorLeft{vector.GetDimension(0).Extent()};
541   for (std::size_t n{result.Elements()}; n-- > 0;) {
542     if (IsLogicalElementTrue(mask, maskAt)) {
543       if (vectorLeft-- == 0) {
544         terminator.Crash("UNPACK: VECTOR= argument has fewer elements than "
545                          "MASK= has .TRUE. entries");
546       }
547       CopyElement(result, resultAt, vector, &vectorAt, terminator);
548       ++vectorAt;
549     } else {
550       CopyElement(result, resultAt, field, fieldAt, terminator);
551     }
552     result.IncrementSubscripts(resultAt);
553     mask.IncrementSubscripts(maskAt);
554     field.IncrementSubscripts(fieldAt);
555   }
556 }
557 
558 } // extern "C"
559 } // namespace Fortran::runtime
560