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