xref: /llvm-project/flang/docs/Intrinsics.md (revision ecc71de53f8786269ce089501432ee555f98f55b)
1<!--===- docs/Intrinsics.md
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# A categorization of standard (2018) and extended Fortran intrinsic procedures
10
11```{contents}
12---
13local:
14---
15```
16
17This note attempts to group the intrinsic procedures of Fortran into categories
18of functions or subroutines with similar interfaces as an aid to
19comprehension beyond that which might be gained from the standard's
20alphabetical list.
21
22A brief status of intrinsic procedure support in f18 is also given at the end.
23
24Few procedures are actually described here apart from their interfaces; see the
25Fortran 2018 standard (section 16) for the complete story.
26
27Intrinsic modules are not covered here.
28
29## General rules
30
311. The value of any intrinsic function's `KIND` actual argument, if present,
32   must be a scalar constant integer expression, of any kind, whose value
33   resolves to some supported kind of the function's result type.
34   If optional and absent, the kind of the function's result is
35   either the default kind of that category or to the kind of an argument
36   (e.g., as in `AINT`).
371. Procedures are summarized with a non-Fortran syntax for brevity.
38   Wherever a function has a short definition, it appears after an
39   equal sign as if it were a statement function.  Any functions referenced
40   in these short summaries are intrinsic.
411. Unless stated otherwise, an actual argument may have any supported kind
42   of a particular intrinsic type.  Sometimes a pattern variable
43   can appear in a description (e.g., `REAL(k)`) when the kind of an
44   actual argument's type must match the kind of another argument, or
45   determines the kind type parameter of the function result.
461. When an intrinsic type name appears without a kind (e.g., `REAL`),
47   it refers to the default kind of that type.  Sometimes the word
48   `default` will appear for clarity.
491. The names of the dummy arguments actually matter because they can
50   be used as keywords for actual arguments.
511. All standard intrinsic functions are pure, even when not elemental.
521. Assumed-rank arguments may not appear as actual arguments unless
53   expressly permitted.
541. When an argument is described with a default value, e.g. `KIND=KIND(0)`,
55   it is an optional argument.  Optional arguments without defaults,
56   e.g. `DIM` on many transformationals, are wrapped in `[]` brackets
57   as in the Fortran standard.  When an intrinsic has optional arguments
58   with and without default values, the arguments with default values
59   may appear within the brackets to preserve the order of arguments
60   (e.g., `COUNT`).
61
62## Elemental intrinsic functions
63
64Pure elemental semantics apply to these functions, to wit: when one or more of
65the actual arguments are arrays, the arguments must be conformable, and
66the result is also an array.
67Scalar arguments are expanded when the arguments are not all scalars.
68
69### Elemental intrinsic functions that may have unrestricted specific procedures
70
71When an elemental intrinsic function is documented here as having an
72_unrestricted specific name_, that name may be passed as an actual
73argument, used as the target of a procedure pointer, appear in
74a generic interface, and be otherwise used as if it were an external
75procedure.
76An `INTRINSIC` statement or attribute may have to be applied to an
77unrestricted specific name to enable such usage.
78
79When a name is being used as a specific procedure for any purpose other
80than that of a called function, the specific instance of the function
81that accepts and returns values of the default kinds of the intrinsic
82types is used.
83A Fortran `INTERFACE` could be written to define each of
84these unrestricted specific intrinsic function names.
85
86Calls to dummy arguments and procedure pointers that correspond to these
87specific names must pass only scalar actual argument values.
88
89No other intrinsic function name can be passed as an actual argument,
90used as a pointer target, appear in a generic interface, or be otherwise
91used except as the name of a called function.
92Some of these _restricted specific intrinsic functions_, e.g. `FLOAT`,
93provide a means for invoking a corresponding generic (`REAL` in the case of `FLOAT`)
94with forced argument and result kinds.
95Others, viz. `CHAR`, `ICHAR`, `INT`, `REAL`, and the lexical comparisons like `LGE`,
96have the same name as their generic functions, and it is not clear what purpose
97is accomplished by the standard by defining them as specific functions.
98
99### Trigonometric elemental intrinsic functions, generic and (mostly) specific
100All of these functions can be used as unrestricted specific names.
101
102```
103ACOS(REAL(k) X) -> REAL(k)
104ASIN(REAL(k) X) -> REAL(k)
105ATAN(REAL(k) X) -> REAL(k)
106ATAN(REAL(k) Y, REAL(k) X) -> REAL(k) = ATAN2(Y, X)
107ATAN2(REAL(k) Y, REAL(k) X) -> REAL(k)
108COS(REAL(k) X) -> REAL(k)
109COSH(REAL(k) X) -> REAL(k)
110SIN(REAL(k) X) -> REAL(k)
111SINH(REAL(k) X) -> REAL(k)
112TAN(REAL(k) X) -> REAL(k)
113TANH(REAL(k) X) -> REAL(k)
114```
115
116These `COMPLEX` versions of some of those functions, and the
117inverse hyperbolic functions, cannot be used as specific names.
118```
119ACOS(COMPLEX(k) X) -> COMPLEX(k)
120ASIN(COMPLEX(k) X) -> COMPLEX(k)
121ATAN(COMPLEX(k) X) -> COMPLEX(k)
122ACOSH(REAL(k) X) -> REAL(k)
123ACOSH(COMPLEX(k) X) -> COMPLEX(k)
124ASINH(REAL(k) X) -> REAL(k)
125ASINH(COMPLEX(k) X) -> COMPLEX(k)
126ATANH(REAL(k) X) -> REAL(k)
127ATANH(COMPLEX(k) X) -> COMPLEX(k)
128COS(COMPLEX(k) X) -> COMPLEX(k)
129COSH(COMPLEX(k) X) -> COMPLEX(k)
130SIN(COMPLEX(k) X) -> COMPLEX(k)
131SINH(COMPLEX(k) X) -> COMPLEX(k)
132TAN(COMPLEX(k) X) -> COMPLEX(k)
133TANH(COMPLEX(k) X) -> COMPLEX(k)
134```
135
136### Non-trigonometric elemental intrinsic functions, generic and specific
137These functions *can* be used as unrestricted specific names.
138```
139ABS(REAL(k) A) -> REAL(k) = SIGN(A, 0.0)
140AIMAG(COMPLEX(k) Z) -> REAL(k) = Z%IM
141AINT(REAL(k) A, KIND=k) -> REAL(KIND)
142ANINT(REAL(k) A, KIND=k) -> REAL(KIND)
143CONJG(COMPLEX(k) Z) -> COMPLEX(k) = CMPLX(Z%RE, -Z%IM)
144DIM(REAL(k) X, REAL(k) Y) -> REAL(k) = X-MIN(X,Y)
145DPROD(default REAL X, default REAL Y) -> DOUBLE PRECISION = DBLE(X)*DBLE(Y)
146EXP(REAL(k) X) -> REAL(k)
147INDEX(CHARACTER(k) STRING, CHARACTER(k) SUBSTRING, LOGICAL(any) BACK=.FALSE., KIND=KIND(0)) -> INTEGER(KIND)
148LEN(CHARACTER(k,n) STRING, KIND=KIND(0)) -> INTEGER(KIND) = n
149LOG(REAL(k) X) -> REAL(k)
150LOG10(REAL(k) X) -> REAL(k)
151MOD(INTEGER(k) A, INTEGER(k) P) -> INTEGER(k) = A-P*INT(A/P)
152NINT(REAL(k) A, KIND=KIND(0)) -> INTEGER(KIND)
153SIGN(REAL(k) A, REAL(k) B) -> REAL(k)
154SQRT(REAL(k) X) -> REAL(k) = X ** 0.5
155```
156
157These variants, however *cannot* be used as specific names without recourse to an alias
158from the following section:
159```
160ABS(INTEGER(k) A) -> INTEGER(k) = SIGN(A, 0)
161ABS(COMPLEX(k) A) -> REAL(k) = HYPOT(A%RE, A%IM)
162DIM(INTEGER(k) X, INTEGER(k) Y) -> INTEGER(k) = X-MIN(X,Y)
163EXP(COMPLEX(k) X) -> COMPLEX(k)
164LOG(COMPLEX(k) X) -> COMPLEX(k)
165MOD(REAL(k) A, REAL(k) P) -> REAL(k) = A-P*INT(A/P)
166SIGN(INTEGER(k) A, INTEGER(k) B) -> INTEGER(k)
167SQRT(COMPLEX(k) X) -> COMPLEX(k)
168```
169
170### Unrestricted specific aliases for some elemental intrinsic functions with distinct names
171
172```
173ALOG(REAL X) -> REAL = LOG(X)
174ALOG10(REAL X) -> REAL = LOG10(X)
175AMOD(REAL A, REAL P) -> REAL = MOD(A, P)
176CABS(COMPLEX A) = ABS(A)
177CCOS(COMPLEX X) = COS(X)
178CEXP(COMPLEX A) -> COMPLEX = EXP(A)
179CLOG(COMPLEX X) -> COMPLEX = LOG(X)
180CSIN(COMPLEX X) -> COMPLEX = SIN(X)
181CSQRT(COMPLEX X) -> COMPLEX = SQRT(X)
182CTAN(COMPLEX X) -> COMPLEX = TAN(X)
183DABS(DOUBLE PRECISION A) -> DOUBLE PRECISION = ABS(A)
184DACOS(DOUBLE PRECISION X) -> DOUBLE PRECISION = ACOS(X)
185DASIN(DOUBLE PRECISION X) -> DOUBLE PRECISION = ASIN(X)
186DATAN(DOUBLE PRECISION X) -> DOUBLE PRECISION = ATAN(X)
187DATAN2(DOUBLE PRECISION Y, DOUBLE PRECISION X) -> DOUBLE PRECISION = ATAN2(Y, X)
188DCOS(DOUBLE PRECISION X) -> DOUBLE PRECISION = COS(X)
189DCOSH(DOUBLE PRECISION X) -> DOUBLE PRECISION = COSH(X)
190DDIM(DOUBLE PRECISION X, DOUBLE PRECISION Y) -> DOUBLE PRECISION = X-MIN(X,Y)
191DEXP(DOUBLE PRECISION X) -> DOUBLE PRECISION = EXP(X)
192DINT(DOUBLE PRECISION A) -> DOUBLE PRECISION = AINT(A)
193DLOG(DOUBLE PRECISION X) -> DOUBLE PRECISION = LOG(X)
194DLOG10(DOUBLE PRECISION X) -> DOUBLE PRECISION = LOG10(X)
195DMOD(DOUBLE PRECISION A, DOUBLE PRECISION P) -> DOUBLE PRECISION = MOD(A, P)
196DNINT(DOUBLE PRECISION A) -> DOUBLE PRECISION = ANINT(A)
197DSIGN(DOUBLE PRECISION A, DOUBLE PRECISION B) -> DOUBLE PRECISION = SIGN(A, B)
198DSIN(DOUBLE PRECISION X) -> DOUBLE PRECISION = SIN(X)
199DSINH(DOUBLE PRECISION X) -> DOUBLE PRECISION = SINH(X)
200DSQRT(DOUBLE PRECISION X) -> DOUBLE PRECISION = SQRT(X)
201DTAN(DOUBLE PRECISION X) -> DOUBLE PRECISION = TAN(X)
202DTANH(DOUBLE PRECISION X) -> DOUBLE PRECISION = TANH(X)
203IABS(INTEGER A) -> INTEGER = ABS(A)
204IDIM(INTEGER X, INTEGER Y) -> INTEGER = X-MIN(X,Y)
205IDNINT(DOUBLE PRECISION A) -> INTEGER = NINT(A)
206ISIGN(INTEGER A, INTEGER B) -> INTEGER = SIGN(A, B)
207```
208
209## Generic elemental intrinsic functions without specific names
210
211(No procedures after this point can be passed as actual arguments, used as
212pointer targets, or appear as specific procedures in generic interfaces.)
213
214### Elemental conversions
215
216```
217ACHAR(INTEGER(k) I, KIND=KIND('')) -> CHARACTER(KIND,LEN=1)
218CEILING(REAL() A, KIND=KIND(0)) -> INTEGER(KIND)
219CHAR(INTEGER(any) I, KIND=KIND('')) -> CHARACTER(KIND,LEN=1)
220CMPLX(COMPLEX(k) X, KIND=KIND(0.0D0)) -> COMPLEX(KIND)
221CMPLX(INTEGER or REAL or BOZ X, INTEGER or REAL or BOZ Y=0, KIND=KIND((0,0))) -> COMPLEX(KIND)
222DBLE(INTEGER or REAL or COMPLEX or BOZ A) = REAL(A, KIND=KIND(0.0D0))
223EXPONENT(REAL(any) X) -> default INTEGER
224FLOOR(REAL(any) A, KIND=KIND(0)) -> INTEGER(KIND)
225IACHAR(CHARACTER(KIND=k,LEN=1) C, KIND=KIND(0)) -> INTEGER(KIND)
226ICHAR(CHARACTER(KIND=k,LEN=1) C, KIND=KIND(0)) -> INTEGER(KIND)
227INT(INTEGER or REAL or COMPLEX or BOZ A, KIND=KIND(0)) -> INTEGER(KIND)
228LOGICAL(LOGICAL(any) L, KIND=KIND(.TRUE.)) -> LOGICAL(KIND)
229REAL(INTEGER or REAL or COMPLEX or BOZ A, KIND=KIND(0.0)) -> REAL(KIND)
230```
231
232### Other generic elemental intrinsic functions without specific names
233N.B. `BESSEL_JN(N1, N2, X)` and `BESSEL_YN(N1, N2, X)` are categorized
234below with the _transformational_ intrinsic functions.
235
236```
237BESSEL_J0(REAL(k) X) -> REAL(k)
238BESSEL_J1(REAL(k) X) -> REAL(k)
239BESSEL_JN(INTEGER(n) N, REAL(k) X) -> REAL(k)
240BESSEL_Y0(REAL(k) X) -> REAL(k)
241BESSEL_Y1(REAL(k) X) -> REAL(k)
242BESSEL_YN(INTEGER(n) N, REAL(k) X) -> REAL(k)
243ERF(REAL(k) X) -> REAL(k)
244ERFC(REAL(k) X) -> REAL(k)
245ERFC_SCALED(REAL(k) X) -> REAL(k)
246FRACTION(REAL(k) X) -> REAL(k)
247GAMMA(REAL(k) X) -> REAL(k)
248HYPOT(REAL(k) X, REAL(k) Y) -> REAL(k) = SQRT(X*X+Y*Y) without spurious overflow
249IMAGE_STATUS(INTEGER(any) IMAGE [, scalar TEAM_TYPE TEAM ]) -> default INTEGER
250IS_IOSTAT_END(INTEGER(any) I) -> default LOGICAL
251IS_IOSTAT_EOR(INTEGER(any) I) -> default LOGICAL
252LOG_GAMMA(REAL(k) X) -> REAL(k)
253MAX(INTEGER(k) ...) -> INTEGER(k)
254MAX(REAL(k) ...) -> REAL(k)
255MAX(CHARACTER(KIND=k) ...) -> CHARACTER(KIND=k,LEN=MAX(LEN(...)))
256MERGE(any type TSOURCE, same type FSOURCE, LOGICAL(any) MASK) -> type of FSOURCE
257MIN(INTEGER(k) ...) -> INTEGER(k)
258MIN(REAL(k) ...) -> REAL(k)
259MIN(CHARACTER(KIND=k) ...) -> CHARACTER(KIND=k,LEN=MAX(LEN(...)))
260MODULO(INTEGER(k) A, INTEGER(k) P) -> INTEGER(k); P*result >= 0
261MODULO(REAL(k) A, REAL(k) P) -> REAL(k) = A - P*FLOOR(A/P)
262NEAREST(REAL(k) X, REAL(any) S) -> REAL(k)
263OUT_OF_RANGE(INTEGER(any) X, scalar INTEGER or REAL(k) MOLD) -> default LOGICAL
264OUT_OF_RANGE(REAL(any) X, scalar REAL(k) MOLD) -> default LOGICAL
265OUT_OF_RANGE(REAL(any) X, scalar INTEGER(any) MOLD, scalar LOGICAL(any) ROUND=.FALSE.) -> default LOGICAL
266RRSPACING(REAL(k) X) -> REAL(k)
267SCALE(REAL(k) X, INTEGER(any) I) -> REAL(k)
268SET_EXPONENT(REAL(k) X, INTEGER(any) I) -> REAL(k)
269SPACING(REAL(k) X) -> REAL(k)
270```
271
272### Restricted specific aliases for elemental conversions &/or extrema with default intrinsic types
273
274```
275AMAX0(INTEGER ...) = REAL(MAX(...))
276AMAX1(REAL ...) = MAX(...)
277AMIN0(INTEGER...) = REAL(MIN(...))
278AMIN1(REAL ...) = MIN(...)
279DMAX1(DOUBLE PRECISION ...) = MAX(...)
280DMIN1(DOUBLE PRECISION ...) = MIN(...)
281FLOAT(INTEGER I) = REAL(I)
282IDINT(DOUBLE PRECISION A) = INT(A)
283IFIX(REAL A) = INT(A)
284MAX0(INTEGER ...) = MAX(...)
285MAX1(REAL ...) = INT(MAX(...))
286MIN0(INTEGER ...) = MIN(...)
287MIN1(REAL ...) = INT(MIN(...))
288SNGL(DOUBLE PRECISION A) = REAL(A)
289```
290
291### Generic elemental bit manipulation intrinsic functions
292Many of these accept a typeless "BOZ" literal as an actual argument.
293It is interpreted as having the kind of intrinsic `INTEGER` type
294as another argument, as if the typeless were implicitly wrapped
295in a call to `INT()`.
296When multiple arguments can be either `INTEGER` values or typeless
297constants, it is forbidden for *all* of them to be typeless
298constants if the result of the function is `INTEGER`
299(i.e., only `BGE`, `BGT`, `BLE`, and `BLT` can have multiple
300typeless arguments).
301
302```
303BGE(INTEGER(n1) or BOZ I, INTEGER(n2) or BOZ J) -> default LOGICAL
304BGT(INTEGER(n1) or BOZ I, INTEGER(n2) or BOZ J) -> default LOGICAL
305BLE(INTEGER(n1) or BOZ I, INTEGER(n2) or BOZ J) -> default LOGICAL
306BLT(INTEGER(n1) or BOZ I, INTEGER(n2) or BOZ J) -> default LOGICAL
307BTEST(INTEGER(n1) I, INTEGER(n2) POS) -> default LOGICAL
308DSHIFTL(INTEGER(k) I, INTEGER(k) or BOZ J, INTEGER(any) SHIFT) -> INTEGER(k)
309DSHIFTL(BOZ I, INTEGER(k), INTEGER(any) SHIFT) -> INTEGER(k)
310DSHIFTR(INTEGER(k) I, INTEGER(k) or BOZ J, INTEGER(any) SHIFT) -> INTEGER(k)
311DSHIFTR(BOZ I, INTEGER(k), INTEGER(any) SHIFT) -> INTEGER(k)
312IAND(INTEGER(k) I, INTEGER(k) or BOZ J) -> INTEGER(k)
313IAND(BOZ I, INTEGER(k) J) -> INTEGER(k)
314IBCLR(INTEGER(k) I, INTEGER(any) POS) -> INTEGER(k)
315IBITS(INTEGER(k) I, INTEGER(n1) POS, INTEGER(n2) LEN) -> INTEGER(k)
316IBSET(INTEGER(k) I, INTEGER(any) POS) -> INTEGER(k)
317IEOR(INTEGER(k) I, INTEGER(k) or BOZ J) -> INTEGER(k)
318IEOR(BOZ I, INTEGER(k) J) -> INTEGER(k)
319IOR(INTEGER(k) I, INTEGER(k) or BOZ J) -> INTEGER(k)
320IOR(BOZ I, INTEGER(k) J) -> INTEGER(k)
321ISHFT(INTEGER(k) I, INTEGER(any) SHIFT) -> INTEGER(k)
322ISHFTC(INTEGER(k) I, INTEGER(n1) SHIFT, INTEGER(n2) SIZE=BIT_SIZE(I)) -> INTEGER(k)
323LEADZ(INTEGER(any) I) -> default INTEGER
324MASKL(INTEGER(any) I, KIND=KIND(0)) -> INTEGER(KIND)
325MASKR(INTEGER(any) I, KIND=KIND(0)) -> INTEGER(KIND)
326MERGE_BITS(INTEGER(k) I, INTEGER(k) or BOZ J, INTEGER(k) or BOZ MASK) = IOR(IAND(I,MASK),IAND(J,NOT(MASK)))
327MERGE_BITS(BOZ I, INTEGER(k) J, INTEGER(k) or BOZ MASK) = IOR(IAND(I,MASK),IAND(J,NOT(MASK)))
328NOT(INTEGER(k) I) -> INTEGER(k)
329POPCNT(INTEGER(any) I) -> default INTEGER
330POPPAR(INTEGER(any) I) -> default INTEGER = IAND(POPCNT(I), Z'1')
331SHIFTA(INTEGER(k) I, INTEGER(any) SHIFT) -> INTEGER(k)
332SHIFTL(INTEGER(k) I, INTEGER(any) SHIFT) -> INTEGER(k)
333SHIFTR(INTEGER(k) I, INTEGER(any) SHIFT) -> INTEGER(k)
334TRAILZ(INTEGER(any) I) -> default INTEGER
335```
336
337### Character elemental intrinsic functions
338See also `INDEX` and `LEN` above among the elemental intrinsic functions with
339unrestricted specific names.
340```
341ADJUSTL(CHARACTER(k,LEN=n) STRING) -> CHARACTER(k,LEN=n)
342ADJUSTR(CHARACTER(k,LEN=n) STRING) -> CHARACTER(k,LEN=n)
343LEN_TRIM(CHARACTER(k,n) STRING, KIND=KIND(0)) -> INTEGER(KIND) = n
344LGE(CHARACTER(k,n1) STRING_A, CHARACTER(k,n2) STRING_B) -> default LOGICAL
345LGT(CHARACTER(k,n1) STRING_A, CHARACTER(k,n2) STRING_B) -> default LOGICAL
346LLE(CHARACTER(k,n1) STRING_A, CHARACTER(k,n2) STRING_B) -> default LOGICAL
347LLT(CHARACTER(k,n1) STRING_A, CHARACTER(k,n2) STRING_B) -> default LOGICAL
348SCAN(CHARACTER(k,n) STRING, CHARACTER(k,m) SET, LOGICAL(any) BACK=.FALSE., KIND=KIND(0)) -> INTEGER(KIND)
349VERIFY(CHARACTER(k,n) STRING, CHARACTER(k,m) SET, LOGICAL(any) BACK=.FALSE., KIND=KIND(0)) -> INTEGER(KIND)
350```
351
352`SCAN` returns the index of the first (or last, if `BACK=.TRUE.`) character in `STRING`
353that is present in `SET`, or zero if none is.
354
355`VERIFY` is essentially the opposite: it returns the index of the first (or last) character
356in `STRING` that is *not* present in `SET`, or zero if all are.
357
358## Transformational intrinsic functions
359
360This category comprises a large collection of intrinsic functions that
361are collected together because they somehow transform their arguments
362in a way that prevents them from being elemental.
363All of them are pure, however.
364
365Some general rules apply to the transformational intrinsic functions:
366
3671. `DIM` arguments are optional; if present, the actual argument must be
368   a scalar integer of any kind.
3691. When an optional `DIM` argument is absent, or an `ARRAY` or `MASK`
370   argument is a vector, the result of the function is scalar; otherwise,
371   the result is an array of the same shape as the `ARRAY` or `MASK`
372   argument with the dimension `DIM` removed from the shape.
3731. When a function takes an optional `MASK` argument, it must be conformable
374  with its `ARRAY` argument if it is present, and the mask can be any kind
375  of `LOGICAL`.  It can be scalar.
3761. The type `numeric` here can be any kind of `INTEGER`, `REAL`, or `COMPLEX`.
3771. The type `relational` here can be any kind of `INTEGER`, `REAL`, or `CHARACTER`.
3781. The type `any` here denotes any intrinsic or derived type.
3791. The notation `(..)` denotes an array of any rank (but not an assumed-rank array).
380
381### Logical reduction transformational intrinsic functions
382```
383ALL(LOGICAL(k) MASK(..) [, DIM ]) -> LOGICAL(k)
384ANY(LOGICAL(k) MASK(..) [, DIM ]) -> LOGICAL(k)
385COUNT(LOGICAL(any) MASK(..) [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
386PARITY(LOGICAL(k) MASK(..) [, DIM ]) -> LOGICAL(k)
387```
388
389### Numeric reduction transformational intrinsic functions
390```
391IALL(INTEGER(k) ARRAY(..) [, DIM, MASK ]) -> INTEGER(k)
392IANY(INTEGER(k) ARRAY(..) [, DIM, MASK ]) -> INTEGER(k)
393IPARITY(INTEGER(k) ARRAY(..) [, DIM, MASK ]) -> INTEGER(k)
394NORM2(REAL(k) X(..) [, DIM ]) -> REAL(k)
395PRODUCT(numeric ARRAY(..) [, DIM, MASK ]) -> numeric
396SUM(numeric ARRAY(..) [, DIM, MASK ]) -> numeric
397```
398
399`NORM2` generalizes `HYPOT` by computing `SQRT(SUM(X*X))` while avoiding spurious overflows.
400
401### Extrema reduction transformational intrinsic functions
402```
403MAXVAL(relational(k) ARRAY(..) [, DIM, MASK ]) -> relational(k)
404MINVAL(relational(k) ARRAY(..) [, DIM, MASK ]) -> relational(k)
405```
406
407### Locational transformational intrinsic functions
408When the optional `DIM` argument is absent, the result is an `INTEGER(KIND)`
409vector whose length is the rank of `ARRAY`.
410When the optional `DIM` argument is present, the result is an `INTEGER(KIND)`
411array of rank `RANK(ARRAY)-1` and shape equal to that of `ARRAY` with
412the dimension `DIM` removed.
413
414The optional `BACK` argument is a scalar LOGICAL value of any kind.
415When present and `.TRUE.`, it causes the function to return the index
416of the *last* occurence of the target or extreme value.
417
418For `FINDLOC`, `ARRAY` may have any of the five intrinsic types, and `VALUE`
419must a scalar value of a type for which `ARRAY==VALUE` or `ARRAY .EQV. VALUE`
420is an acceptable expression.
421
422```
423FINDLOC(intrinsic ARRAY(..), scalar VALUE [, DIM, MASK, KIND=KIND(0), BACK=.FALSE. ])
424MAXLOC(relational ARRAY(..) [, DIM, MASK, KIND=KIND(0), BACK=.FALSE. ])
425MINLOC(relational ARRAY(..) [, DIM, MASK, KIND=KIND(0), BACK=.FALSE. ])
426```
427
428### Data rearrangement transformational intrinsic functions
429The optional `DIM` argument to these functions must be a scalar integer of
430any kind, and it takes a default value of 1 when absent.
431
432```
433CSHIFT(any ARRAY(..), INTEGER(any) SHIFT(..) [, DIM ]) -> same type/kind/shape as ARRAY
434```
435Either `SHIFT` is scalar or `RANK(SHIFT) == RANK(ARRAY) - 1` and `SHAPE(SHIFT)` is that of `SHAPE(ARRAY)` with element `DIM` removed.
436
437```
438EOSHIFT(any ARRAY(..), INTEGER(any) SHIFT(..) [, BOUNDARY, DIM ]) -> same type/kind/shape as ARRAY
439```
440* `SHIFT` is scalar or `RANK(SHIFT) == RANK(ARRAY) - 1` and `SHAPE(SHIFT)` is that of `SHAPE(ARRAY)` with element `DIM` removed.
441* If `BOUNDARY` is present, it must have the same type and parameters as `ARRAY`.
442* If `BOUNDARY` is absent, `ARRAY` must be of an intrinsic type, and the default `BOUNDARY` is the obvious `0`, `' '`, or `.FALSE.` value of `KIND(ARRAY)`.
443* If `BOUNDARY` is present, either it is scalar, or `RANK(BOUNDARY) == RANK(ARRAY) - 1` and `SHAPE(BOUNDARY)` is that of `SHAPE(ARRAY)` with element `DIM`
444  removed.
445
446```
447PACK(any ARRAY(..), LOGICAL(any) MASK(..)) -> vector of same type and kind as ARRAY
448```
449* `MASK` is conformable with `ARRAY` and may be scalar.
450* The length of the result vector is `COUNT(MASK)` if `MASK` is an array, else `SIZE(ARRAY)` if `MASK` is `.TRUE.`, else zero.
451
452```
453PACK(any ARRAY(..), LOGICAL(any) MASK(..), any VECTOR(n)) -> vector of same type, kind, and size as VECTOR
454```
455* `MASK` is conformable with `ARRAY` and may be scalar.
456* `VECTOR` has the same type and kind as `ARRAY`.
457* `VECTOR` must not be smaller than result of `PACK` with no `VECTOR` argument.
458* The leading elements of `VECTOR` are replaced with elements from `ARRAY` as
459  if `PACK` had been invoked without `VECTOR`.
460
461```
462RESHAPE(any SOURCE(..), INTEGER(k) SHAPE(n) [, PAD(..), INTEGER(k2) ORDER(n) ]) -> SOURCE array with shape SHAPE
463```
464* If `ORDER` is present, it is a vector of the same size as `SHAPE`, and
465  contains a permutation.
466* The element(s) of `PAD` are used to fill out the result once `SOURCE`
467  has been consumed.
468
469```
470SPREAD(any SOURCE, DIM, scalar INTEGER(any) NCOPIES) -> same type as SOURCE, rank=RANK(SOURCE)+1
471TRANSFER(any SOURCE, any MOLD) -> scalar if MOLD is scalar, else vector; same type and kind as MOLD
472TRANSFER(any SOURCE, any MOLD, scalar INTEGER(any) SIZE) -> vector(SIZE) of type and kind of MOLD
473TRANSPOSE(any MATRIX(n,m)) -> matrix(m,n) of same type and kind as MATRIX
474```
475
476The shape of the result of `SPREAD` is the same as that of `SOURCE`, with `NCOPIES` inserted
477at position `DIM`.
478
479```
480UNPACK(any VECTOR(n), LOGICAL(any) MASK(..), FIELD) -> type and kind of VECTOR, shape of MASK
481```
482`FIELD` has same type and kind as `VECTOR` and is conformable with `MASK`.
483
484### Other transformational intrinsic functions
485```
486BESSEL_JN(INTEGER(n1) N1, INTEGER(n2) N2, REAL(k) X) -> REAL(k) vector (MAX(N2-N1+1,0))
487BESSEL_YN(INTEGER(n1) N1, INTEGER(n2) N2, REAL(k) X) -> REAL(k) vector (MAX(N2-N1+1,0))
488COMMAND_ARGUMENT_COUNT() -> scalar default INTEGER
489DOT_PRODUCT(LOGICAL(k) VECTOR_A(n), LOGICAL(k) VECTOR_B(n)) -> LOGICAL(k) = ANY(VECTOR_A .AND. VECTOR_B)
490DOT_PRODUCT(COMPLEX(any) VECTOR_A(n), numeric VECTOR_B(n)) = SUM(CONJG(VECTOR_A) * VECTOR_B)
491DOT_PRODUCT(INTEGER(any) or REAL(any) VECTOR_A(n), numeric VECTOR_B(n)) = SUM(VECTOR_A * VECTOR_B)
492MATMUL(numeric ARRAY_A(j), numeric ARRAY_B(j,k)) -> numeric vector(k)
493MATMUL(numeric ARRAY_A(j,k), numeric ARRAY_B(k)) -> numeric vector(j)
494MATMUL(numeric ARRAY_A(j,k), numeric ARRAY_B(k,m)) -> numeric matrix(j,m)
495MATMUL(LOGICAL(n1) ARRAY_A(j), LOGICAL(n2) ARRAY_B(j,k)) -> LOGICAL vector(k)
496MATMUL(LOGICAL(n1) ARRAY_A(j,k), LOGICAL(n2) ARRAY_B(k)) -> LOGICAL vector(j)
497MATMUL(LOGICAL(n1) ARRAY_A(j,k), LOGICAL(n2) ARRAY_B(k,m)) -> LOGICAL matrix(j,m)
498NULL([POINTER/ALLOCATABLE MOLD]) -> POINTER
499REDUCE(any ARRAY(..), function OPERATION [, DIM, LOGICAL(any) MASK(..), IDENTITY, LOGICAL ORDERED=.FALSE. ])
500REPEAT(CHARACTER(k,n) STRING, INTEGER(any) NCOPIES) -> CHARACTER(k,n*NCOPIES)
501SELECTED_CHAR_KIND('DEFAULT' or 'ASCII' or 'ISO_10646' or ...) -> scalar default INTEGER
502SELECTED_INT_KIND(scalar INTEGER(any) R) -> scalar default INTEGER
503SELECTED_REAL_KIND([scalar INTEGER(any) P, scalar INTEGER(any) R, scalar INTEGER(any) RADIX]) -> scalar default INTEGER
504SHAPE(SOURCE, KIND=KIND(0)) -> INTEGER(KIND)(RANK(SOURCE))
505TRIM(CHARACTER(k,n) STRING) -> CHARACTER(k)
506```
507
508The type and kind of the result of a numeric `MATMUL` is the same as would result from
509a multiplication of an element of ARRAY_A and an element of ARRAY_B.
510
511The kind of the `LOGICAL` result of a `LOGICAL` `MATMUL` is the same as would result
512from an intrinsic `.AND.` operation between an element of `ARRAY_A` and an element
513of `ARRAY_B`.
514
515Note that `DOT_PRODUCT` with a `COMPLEX` first argument operates on its complex conjugate,
516but that `MATMUL` with a `COMPLEX` argument does not.
517
518The `MOLD` argument to `NULL` may be omitted only in a context where the type of the pointer is known,
519such as an initializer or pointer assignment statement.
520
521At least one argument must be present in a call to `SELECTED_REAL_KIND`.
522
523An assumed-rank array may be passed to `SHAPE`, and if it is associated with an assumed-size array,
524the last element of the result will be -1.
525
526### Coarray transformational intrinsic functions
527```
528FAILED_IMAGES([scalar TEAM_TYPE TEAM, KIND=KIND(0)]) -> INTEGER(KIND) vector
529GET_TEAM([scalar INTEGER(?) LEVEL]) -> scalar TEAM_TYPE
530IMAGE_INDEX(COARRAY, INTEGER(any) SUB(n) [, scalar TEAM_TYPE TEAM ]) -> scalar default INTEGER
531IMAGE_INDEX(COARRAY, INTEGER(any) SUB(n), scalar INTEGER(any) TEAM_NUMBER) -> scalar default INTEGER
532NUM_IMAGES([scalar TEAM_TYPE TEAM]) -> scalar default INTEGER
533NUM_IMAGES(scalar INTEGER(any) TEAM_NUMBER) -> scalar default INTEGER
534STOPPED_IMAGES([scalar TEAM_TYPE TEAM, KIND=KIND(0)]) -> INTEGER(KIND) vector
535TEAM_NUMBER([scalar TEAM_TYPE TEAM]) -> scalar default INTEGER
536THIS_IMAGE([COARRAY, DIM, scalar TEAM_TYPE TEAM]) -> default INTEGER
537```
538The result of `THIS_IMAGE` is a scalar if `DIM` is present or if `COARRAY` is absent,
539and a vector whose length is the corank of `COARRAY` otherwise.
540
541## Inquiry intrinsic functions
542These are neither elemental nor transformational; all are pure.
543
544### Type inquiry intrinsic functions
545All of these functions return constants.
546The value of the argument is not used, and may well be undefined.
547```
548BIT_SIZE(INTEGER(k) I(..)) -> INTEGER(k)
549DIGITS(INTEGER or REAL X(..)) -> scalar default INTEGER
550EPSILON(REAL(k) X(..)) -> scalar REAL(k)
551HUGE(INTEGER(k) X(..)) -> scalar INTEGER(k)
552HUGE(REAL(k) X(..)) -> scalar of REAL(k)
553KIND(intrinsic X(..)) -> scalar default INTEGER
554MAXEXPONENT(REAL(k) X(..)) -> scalar default INTEGER
555MINEXPONENT(REAL(k) X(..)) -> scalar default INTEGER
556NEW_LINE(CHARACTER(k,n) A(..)) -> scalar CHARACTER(k,1) = CHAR(10)
557PRECISION(REAL(k) or COMPLEX(k) X(..)) -> scalar default INTEGER
558RADIX(INTEGER(k) or REAL(k) X(..)) -> scalar default INTEGER, always 2
559RANGE(INTEGER(k) or REAL(k) or COMPLEX(k) X(..)) -> scalar default INTEGER
560TINY(REAL(k) X(..)) -> scalar REAL(k)
561```
562
563### Bound and size inquiry intrinsic functions
564The results are scalar when `DIM` is present, and a vector of length=(co)rank(`(CO)ARRAY`)
565when `DIM` is absent.
566```
567LBOUND(any ARRAY(..) [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
568LCOBOUND(any COARRAY [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
569SIZE(any ARRAY(..) [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
570UBOUND(any ARRAY(..) [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
571UCOBOUND(any COARRAY [, DIM, KIND=KIND(0) ]) -> INTEGER(KIND)
572```
573
574Assumed-rank arrays may be used with `LBOUND`, `SIZE`, and `UBOUND`.
575
576### Object characteristic inquiry intrinsic functions
577```
578ALLOCATED(any type ALLOCATABLE ARRAY) -> scalar default LOGICAL
579ALLOCATED(any type ALLOCATABLE SCALAR) -> scalar default LOGICAL
580ASSOCIATED(any type POINTER POINTER [, same type TARGET]) -> scalar default LOGICAL
581COSHAPE(COARRAY, KIND=KIND(0)) -> INTEGER(KIND) vector of length corank(COARRAY)
582EXTENDS_TYPE_OF(A, MOLD) -> default LOGICAL
583IS_CONTIGUOUS(any data ARRAY(..)) -> scalar default LOGICAL
584PRESENT(OPTIONAL A) -> scalar default LOGICAL
585RANK(any data A) -> scalar default INTEGER = 0 if A is scalar, SIZE(SHAPE(A)) if A is an array, rank if assumed-rank
586SAME_TYPE_AS(A, B) -> scalar default LOGICAL
587STORAGE_SIZE(any data A, KIND=KIND(0)) -> INTEGER(KIND)
588```
589The arguments to `EXTENDS_TYPE_OF` must be of extensible derived types or be unlimited polymorphic.
590
591An assumed-rank array may be used with `IS_CONTIGUOUS` and `RANK`.
592
593## Intrinsic subroutines
594
595(*TODO*: complete these descriptions)
596
597### One elemental intrinsic subroutine
598```
599INTERFACE
600  SUBROUTINE MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)
601    INTEGER(k1) :: FROM, TO
602    INTENT(IN) :: FROM
603    INTENT(INOUT) :: TO
604    INTEGER(k2), INTENT(IN) :: FROMPOS
605    INTEGER(k3), INTENT(IN) :: LEN
606    INTEGER(k4), INTENT(IN) :: TOPOS
607  END SUBROUTINE
608END INTERFACE
609```
610
611### Non-elemental intrinsic subroutines
612```
613CALL CPU_TIME(REAL INTENT(OUT) TIME)
614```
615The kind of `TIME` is not specified in the standard.
616
617```
618CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])
619```
620* All arguments are `OPTIONAL` and `INTENT(OUT)`.
621* `DATE`, `TIME`, and `ZONE` are scalar default `CHARACTER`.
622* `VALUES` is a vector of at least 8 elements of `INTEGER(KIND >= 2)`.
623```
624CALL EVENT_QUERY(EVENT, COUNT [, STAT])
625CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])
626CALL GET_COMMAND([COMMAND, LENGTH, STATUS, ERRMSG ])
627CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS, ERRMSG ])
628CALL GET_ENVIRONMENT_VARIABLE(NAME [, VALUE, LENGTH, STATUS, TRIM_NAME, ERRMSG ])
629CALL MOVE_ALLOC(ALLOCATABLE INTENT(INOUT) FROM, ALLOCATABLE INTENT(OUT) TO [, STAT, ERRMSG ])
630CALL RANDOM_INIT(LOGICAL(k1) INTENT(IN) REPEATABLE, LOGICAL(k2) INTENT(IN) IMAGE_DISTINCT)
631CALL RANDOM_NUMBER(REAL(k) INTENT(OUT) HARVEST(..))
632CALL RANDOM_SEED([SIZE, PUT, GET])
633CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])
634```
635
636### Atomic intrinsic subroutines
637```
638CALL ATOMIC_ADD(ATOM, VALUE [, STAT=])
639CALL ATOMIC_AND(ATOM, VALUE [, STAT=])
640CALL ATOMIC_CAS(ATOM, OLD, COMPARE, NEW [, STAT=])
641CALL ATOMIC_DEFINE(ATOM, VALUE [, STAT=])
642CALL ATOMIC_FETCH_ADD(ATOM, VALUE, OLD [, STAT=])
643CALL ATOMIC_FETCH_AND(ATOM, VALUE, OLD [, STAT=])
644CALL ATOMIC_FETCH_OR(ATOM, VALUE, OLD [, STAT=])
645CALL ATOMIC_FETCH_XOR(ATOM, VALUE, OLD [, STAT=])
646CALL ATOMIC_OR(ATOM, VALUE [, STAT=])
647CALL ATOMIC_REF(VALUE, ATOM [, STAT=])
648CALL ATOMIC_XOR(ATOM, VALUE [, STAT=])
649```
650
651### Collective intrinsic subroutines
652```
653CALL CO_BROADCAST
654CALL CO_MAX
655CALL CO_MIN
656CALL CO_REDUCE
657CALL CO_SUM
658```
659
660### Inquiry Functions
661ACCESS (GNU extension) is not supported on Windows. Otherwise:
662```
663CHARACTER(LEN=*) :: path = 'path/to/file'
664IF (ACCESS(path, 'rwx')) &
665  ...
666```
667
668## Non-standard intrinsics
669### PGI
670```
671AND, OR, XOR
672LSHIFT, RSHIFT, SHIFT
673ZEXT, IZEXT
674COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D
675COMPL
676DCMPLX
677EQV, NEQV
678INT8
679JINT, JNINT, KNINT
680LOC
681```
682
683### Intel
684```
685DCMPLX(X,Y), QCMPLX(X,Y)
686DREAL(DOUBLE COMPLEX A) -> DOUBLE PRECISION
687DFLOAT, DREAL
688QEXT, QFLOAT, QREAL
689DNUM, INUM, JNUM, KNUM, QNUM, RNUM - scan value from string
690ZEXT
691RAN, RANF
692ILEN(I) = BIT_SIZE(I)
693SIZEOF
694MCLOCK, SECNDS
695COTAN(X) = 1.0/TAN(X)
696COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COTAND - degrees
697AND, OR, XOR
698LSHIFT, RSHIFT
699IBCHNG, ISHA, ISHC, ISHL, IXOR
700IARG, IARGC, NARGS, NUMARG
701BADDRESS, IADDR
702CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, LOC
703MALLOC, FREE
704```
705
706### Library subroutine
707```
708CALL BACKTRACE()
709CALL FDATE(TIME)
710CALL GETLOG(USRNAME)
711CALL GETENV(NAME [, VALUE, LENGTH, STATUS, TRIM_NAME, ERRMSG ])
712```
713
714## Intrinsic Procedure Name Resolution
715
716When the name of a procedure in a program is the same as the one of an intrinsic
717procedure, and nothing other than its usage allows to decide whether the procedure
718is the intrinsic or not (i.e, it does not appear in an INTRINSIC or EXTERNAL attribute
719statement, is not an use/host associated procedure...), Fortran 2018 standard
720section 19.5.1.4 point 6 rules that the procedure is established to be intrinsic if it is
721invoked as an intrinsic procedure.
722
723In case the invocation would be an error if the procedure were the intrinsic
724(e.g. wrong argument number or type), the broad wording of the standard
725leaves two choices to the compiler: emit an error about the intrinsic invocation,
726or consider this is an external procedure and emit no error.
727
728f18 will always consider this case to be the intrinsic and emit errors, unless the procedure
729is used as a function (resp. subroutine) and the intrinsic is a subroutine (resp. function).
730The table below gives some examples of decisions made by Fortran compilers in such case.
731
732| What is ACOS ?     | Bad intrinsic call       | External with warning |  External no warning | Other error |
733| --- | --- | --- | --- | --- |
734| `print*, ACOS()`     | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
735| `print*, ACOS(I)`    | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
736| `print*, ACOS(X=I)`  | gfortran, nag, xlf, f18  |  ifort                |                      | nvfortran (keyword on implicit extrenal )|
737| `print*, ACOS(X, X)` | gfortran, nag, xlf, f18  |  ifort                |  nvfortran           | |
738| `CALL ACOS(X)`       |                          |                       |  gfortran, nag, xlf, nvfortran, ifort, f18  | |
739
740
741The rationale for f18 behavior is that when referring to a procedure with an
742argument number or type that does not match the intrinsic specification, it seems safer to block
743the rather likely case where the user is using the intrinsic the wrong way.
744In case the user wanted to refer to an external function, he can add an explicit EXTERNAL
745statement with no other consequences on the program.
746However, it seems rather unlikely that a user would confuse an intrinsic subroutine for a
747function and vice versa. Given no compiler is issuing an error here, changing the behavior might
748affect existing programs that omit the EXTERNAL attribute in such case.
749
750Also note that in general, the standard gives the compiler the right to consider
751any procedure that is not explicitly external as a non standard intrinsic (section 4.2 point 4).
752So it is highly advised for the programmer to use EXTERNAL statements to prevent any ambiguity.
753
754## Intrinsic Procedure Support in f18
755This section gives an overview of the support inside f18 libraries for the
756intrinsic procedures listed above.
757It may be outdated, refer to f18 code base for the actual support status.
758
759### Semantic Analysis
760F18 semantic expression analysis phase detects intrinsic procedure references,
761validates the argument types and deduces the return types.
762This phase currently supports all the intrinsic procedures listed above but the ones in the table below.
763
764| Intrinsic Category | Intrinsic Procedures Lacking Support |
765| --- | --- |
766| Coarray intrinsic functions | COSHAPE |
767| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
768| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
769| Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC, FREE, GETUID, GETGID |
770| Intrinsic subroutines |MVBITS (elemental), CHDIR, CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK |
771| Atomic intrinsic subroutines | ATOMIC_ADD |
772| Collective intrinsic subroutines | CO_REDUCE |
773| Library subroutines | BACKTRACE, FDATE, GETLOG, GETENV |
774
775
776### Intrinsic Function Folding
777Fortran Constant Expressions can contain references to a certain number of
778intrinsic functions (see Fortran 2018 standard section 10.1.12 for more details).
779Constant Expressions may be used to define kind arguments. Therefore, the semantic
780expression analysis phase must be able to fold references to intrinsic functions
781listed in section 10.1.12.
782
783F18 intrinsic function folding is either performed by implementations directly
784operating on f18 scalar types or by using host runtime functions and
785host hardware types. F18 supports folding elemental intrinsic functions over
786arrays when an implementation is provided for the scalars (regardless of whether
787it is using host hardware types or not).
788The status of intrinsic function folding support is given in the sub-sections below.
789
790#### Intrinsic Functions with Host Independent Folding Support
791Implementations using f18 scalar types enables folding intrinsic functions
792on any host and with any possible type kind supported by f18. The intrinsic functions
793listed below are folded using host independent implementations.
794
795| Return Type | Intrinsic Functions with Host Independent Folding Support|
796| --- | --- |
797| INTEGER| ABS(INTEGER(k)), DIM(INTEGER(k), INTEGER(k)), DSHIFTL, DSHIFTR, IAND, IBCLR, IBSET, IEOR, INT, IOR, ISHFT, KIND, LEN, LEADZ, MASKL, MASKR, MERGE_BITS, POPCNT, POPPAR, SHIFTA, SHIFTL, SHIFTR, TRAILZ |
798| REAL | ABS(REAL(k)), ABS(COMPLEX(k)), AIMAG, AINT, DPROD, REAL |
799| COMPLEX | CMPLX, CONJG |
800| LOGICAL | BGE, BGT, BLE, BLT |
801
802#### Intrinsic Functions with Host Dependent Folding Support
803Implementations using the host runtime may not be available for all supported
804f18 types depending on the host hardware types and the libraries available on the host.
805The actual support on a host depends on what the host hardware types are.
806The list below gives the functions that are folded using host runtime and the related C/C++ types.
807F18 automatically detects if these types match an f18 scalar type. If so,
808folding of the intrinsic functions will be possible for the related f18 scalar type,
809otherwise an error message will be produced by f18 when attempting to fold related intrinsic functions.
810
811| C/C++ Host Type | Intrinsic Functions with Host Standard C++ Library Based Folding Support |
812| --- | --- |
813| float, double and long double | ACOS, ACOSH, ASINH, ATAN, ATAN2, ATANH, COS, COSH, ERF, ERFC, EXP, GAMMA, HYPOT, LOG, LOG10, LOG_GAMMA, MOD, SIN, SQRT, SINH, SQRT, TAN, TANH |
814| std::complex for float, double and long double| ACOS, ACOSH, ASIN, ASINH, ATAN, ATANH, COS, COSH, EXP, LOG, SIN, SINH, SQRT, TAN, TANH |
815
816On top of the default usage of C++ standard library functions for folding described
817in the table above, it is possible to compile f18 evaluate library with
818[libpgmath](https://github.com/flang-compiler/flang/tree/master/runtime/libpgmath)
819so that it can be used for folding. To do so, one must have a compiled version
820of the libpgmath library available on the host and add
821`-DLIBPGMATH_DIR=<path to the compiled shared libpgmath library>` to the f18 cmake command.
822
823Libpgmath comes with real and complex functions that replace C++ standard library
824float and double functions to fold all the intrinsic functions listed in the table above.
825It has no long double versions. If the host long double matches an f18 scalar type,
826C++ standard library functions will still be used for folding expressions with this scalar type.
827Libpgmath adds the possibility to fold the following functions for f18 real scalar
828types related to host float and double types.
829
830| C/C++ Host Type | Additional Intrinsic Function Folding Support with Libpgmath (Optional) |
831| --- | --- |
832|float and double| BESSEL_J0, BESSEL_J1, BESSEL_JN (elemental only), BESSEL_Y0, BESSEL_Y1, BESSEL_Yn (elemental only), ERFC_SCALED |
833
834Libpgmath comes in three variants (precise, relaxed and fast). So far, only the
835precise version is used for intrinsic function folding in f18. It guarantees the greatest numerical precision.
836
837### Intrinsic Functions with Missing Folding Support
838The following intrinsic functions are allowed in constant expressions but f18
839is not yet able to fold them. Note that there might be constraints on the arguments
840so that these intrinsics can be used in constant expressions (see section 10.1.12 of Fortran 2018 standard).
841
842ALL, ACHAR, ADJUSTL, ADJUSTR, ANINT, ANY, BESSEL_JN (transformational only),
843BESSEL_YN (transformational only), BTEST, CEILING, CHAR, COUNT, CSHIFT, DOT_PRODUCT,
844DIM (REAL only), DOT_PRODUCT, EOSHIFT, FINDLOC, FLOOR, FRACTION, HUGE, IACHAR, IALL,
845IANY, IPARITY, IBITS, ICHAR, IMAGE_STATUS, INDEX, ISHFTC, IS_IOSTAT_END,
846IS_IOSTAT_EOR, LBOUND, LEN_TRIM, LGE, LGT, LLE, LLT, LOGICAL, MATMUL, MAX, MAXLOC,
847MAXVAL, MERGE, MIN, MINLOC, MINVAL, MOD (INTEGER only), MODULO, NEAREST, NINT,
848NORM2, NOT, OUT_OF_RANGE, PACK, PARITY, PRODUCT, REPEAT, REDUCE, RESHAPE,
849RRSPACING, SCAN, SCALE, SELECTED_CHAR_KIND, SELECTED_INT_KIND, SELECTED_REAL_KIND,
850SET_EXPONENT, SHAPE, SIGN, SIZE, SPACING, SPREAD, SUM, TINY, TRANSFER, TRANSPOSE,
851TRIM, UBOUND, UNPACK, VERIFY.
852
853Coarray, non standard, IEEE and ISO_C_BINDINGS intrinsic functions that can be
854used in constant expressions have currently no folding support at all.
855
856### Standard Intrinsics: EXECUTE_COMMAND_LINE
857
858#### Usage and Info
859
860- **Standard:** Fortran 2008 and later, specified in subclause 16.9.73
861- **Class:** Subroutine
862- **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])`
863- **Arguments:**
864
865| Argument   | Description                                                           |
866|------------|-----------------------------------------------------------------------|
867| `COMMAND`  | Shall be a default CHARACTER scalar.                                  |
868| `WAIT`     | (Optional) Shall be a default LOGICAL scalar.                         |
869| `EXITSTAT` | (Optional) Shall be an INTEGER with kind greater than or equal to 4.  |
870| `CMDSTAT`  | (Optional) Shall be an INTEGER with kind greater than or equal to 2.  |
871| `CMDMSG`   | (Optional) Shall be a CHARACTER scalar of the default kind.           |
872
873#### Implementation Specifics
874
875##### `COMMAND`:
876
877- Must be preset.
878
879##### `WAIT`:
880
881- If set to `false`, the command is executed asynchronously.
882- If not preset or set to `true`, it is executed synchronously.
883- Synchronous execution is achieved by passing the command into `std::system` on all systems.
884- Asynchronous execution is achieved by calling `fork()` on POSIX-compatible systems or `CreateProcess()` on Windows.
885
886##### `EXITSTAT`:
887
888- Synchronous execution:
889  - Inferred by the return value of `std::system(cmd)`.
890    - On POSIX-compatible systems: return value is first passed into `WEXITSTATUS(status)`, then assigned to `EXITSTAT`.
891    - On Windows, the value is directly assigned as the return value of `std::system()`.
892- Asynchronous execution:
893  - Value is not modified.
894
895##### `CMDSTAT`:
896
897- Synchronous execution:
898  - -2: `ASYNC_NO_SUPPORT_ERR` - No error condition occurs, but `WAIT` is present with the value `false`, and the processor does not support asynchronous execution.
899  - -1: `NO_SUPPORT_ERR` - The processor does not support command line execution. (system returns -1 with errno `ENOENT`)
900  - 0: `CMD_EXECUTED` - Command executed with no error.
901  - \+ (positive value): An error condition occurs.
902    - 1: `FORK_ERR` - Fork Error (occurs only on POSIX-compatible systems).
903    - 2: `EXECL_ERR` - Execution Error (system returns -1 with other errno).
904    - 3: `COMMAND_EXECUTION_ERR` - Invalid Command Error (exit code 1).
905    - 4: `COMMAND_CANNOT_EXECUTE_ERR` - Command Cannot Execute Error (Linux exit code 126).
906    - 5: `COMMAND_NOT_FOUND_ERR` - Command Not Found Error (Linux exit code 127).
907    - 6: `INVALID_CL_ERR` - Invalid Command Line Error (covers all other non-zero exit codes).
908    - 7: `SIGNAL_ERR` - Signal error (either stopped or killed by signal, occurs only on POSIX-compatible systems).
909- Asynchronous execution:
910  - 0 will always be assigned.
911
912##### `CMDMSG`:
913
914- Synchronous execution:
915  - If an error condition occurs, it is assigned an explanatory message; otherwise, it remains unchanged.
916  - If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated (applies to both POSIX-compatible systems and Windows).
917- Asynchronous execution:
918  - The value is unchanged.
919  - If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
920    - On POSIX-compatible systems, the child process (async process) will be terminated with no effect on the parent process (continues).
921    - On Windows, error termination is not initiated.
922
923### Non-Standard Intrinsics: ETIME
924
925#### Description
926`ETIME(VALUES, TIME)` returns the number of seconds of runtime since the start of the process’s execution in *TIME*. *VALUES* returns the user and system components of this time in `VALUES(1)` and `VALUES(2)` respectively. *TIME* is equal to `VALUES(1) + VALUES(2)`.
927
928On some systems, the underlying timings are represented using types with sufficiently small limits that overflows (wrap around) are possible, such as 32-bit types. Therefore, the values returned by this intrinsic might be, or become, negative, or numerically less than previous values, during a single run of the compiled program.
929
930This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
931
932*VALUES* and *TIME* are `INTENT(OUT)` and provide the following:
933
934
935|               |                                   |
936|---------------|-----------------------------------|
937| `VALUES(1)`   | User time in seconds.             |
938| `VALUES(2)`   | System time in seconds.           |
939| `TIME`        | Run time since start in seconds.  |
940
941#### Usage and Info
942
943- **Standard:** GNU extension
944- **Class:** Subroutine, function
945- **Syntax:** `CALL ETIME(VALUES, TIME)`
946- **Arguments:**
947- **Return value** Elapsed time in seconds since the start of program execution.
948
949| Argument   | Description                                                           |
950|------------|-----------------------------------------------------------------------|
951| `VALUES`   | The type shall be REAL(4), DIMENSION(2).                              |
952| `TIME`     | The type shall be REAL(4).                                            |
953
954#### Example
955Here is an example usage from [Gfortran ETIME](https://gcc.gnu.org/onlinedocs/gfortran/ETIME.html)
956```Fortran
957program test_etime
958    integer(8) :: i, j
959    real, dimension(2) :: tarray
960    real :: result
961    call ETIME(tarray, result)
962    print *, result
963    print *, tarray(1)
964    print *, tarray(2)
965    do i=1,100000000    ! Just a delay
966        j = i * i - i
967    end do
968    call ETIME(tarray, result)
969    print *, result
970    print *, tarray(1)
971    print *, tarray(2)
972end program test_etime
973```
974
975### Non-Standard Intrinsics: GETCWD
976
977#### Description
978`GETCWD(C, STATUS)` returns current working directory.
979
980This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
981
982*C* and *STATUS* are `INTENT(OUT)` and provide the following:
983
984|            |                                                                                                   |
985|------------|---------------------------------------------------------------------------------------------------|
986| `C`        | Current work directory. The type shall be `CHARACTER` and of default kind.       |
987| `STATUS`   | (Optional) Status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of a kind greater or equal to 4. |
988
989#### Usage and Info
990
991- **Standard:** GNU extension
992- **Class:** Subroutine, function
993- **Syntax:** `CALL GETCWD(C, STATUS)`, `STATUS = GETCWD(C)`
994
995#### Example
996```Fortran
997PROGRAM example_getcwd
998  CHARACTER(len=255) :: cwd
999  INTEGER :: status
1000  CALL getcwd(cwd, status)
1001  PRINT *, cwd
1002  PRINT *, status
1003END PROGRAM
1004```
1005
1006### Non-standard Intrinsics: RENAME
1007`RENAME(OLD, NEW[, STATUS])` renames/moves a file on the filesystem.
1008
1009This intrinsic is provided in both subroutine and function form; however, only one form can be used in any given program unit.
1010
1011#### Usage and Info
1012
1013- **Standard:** GNU extension
1014- **Class:** Subroutine, function
1015- **Syntax:** `CALL RENAME(SRC, DST[, STATUS])`
1016- **Arguments:**
1017- **Return value** status code (0: success, non-zero for errors)
1018
1019| Argument | Description                       |
1020|----------|-----------------------------------|
1021| `SRC`    | Source path                       |
1022| `DST`    | Destination path                  |
1023| `STATUS` | Status code (for subroutine form) |
1024
1025The status code returned by both the subroutine and function form corresponds to the value of `errno` if the invocation of `rename(2)` was not successful.
1026
1027#### Example
1028
1029Function form:
1030```
1031program rename_func
1032    implicit none
1033    integer :: status
1034    status = rename('src', 'dst')
1035    print *, 'status:', status
1036    status = rename('dst', 'src')
1037    print *, 'status:', status
1038end program rename_func
1039```
1040
1041Subroutine form:
1042```
1043program rename_proc
1044    implicit none
1045    integer :: status
1046    call rename('src', 'dst', status)
1047    print *, 'status:', status
1048    call rename('dst', 'src')
1049end program rename_proc
1050```
1051
1052### Non-standard Intrinsics: SECOND
1053This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a
1054function form.
1055
1056### Non-standard Intrinsics: LNBLNK
1057This intrinsic is an alias for `LEN_TRIM`, without the optional KIND argument.
1058
1059#### Usage and Info
1060
1061- **Standard:** GNU extension
1062- **Class:** Subroutine, function
1063- **Syntax:** `CALL SECOND(TIME)` or `TIME = SECOND()`
1064- **Arguments:** `TIME` - a REAL value into which the elapsed CPU time in
1065                          seconds is written
1066- **RETURN value:** same as TIME argument
1067
1068### Non-Standard Intrinsics: CHDIR
1069
1070#### Description
1071`CHDIR(NAME[, STATUS])` Change current working directory to a specified path.
1072
1073This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
1074*STATUS* is `INTENT(OUT)` and provide the following:
1075
1076|            |                                                                                                   |
1077|------------|---------------------------------------------------------------------------------------------------|
1078| `NAME`     | The type shall be `CHARACTER` of default kind and shall specify a valid path within the file system.       |
1079| `STATUS`   | (Optional) Status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of the default kind. |
1080
1081#### Usage and Info
1082
1083- **Standard:** GNU extension
1084- **Class:** Subroutine, function
1085- **Syntax:** `CALL CHDIR(NAME[, STATUS])` and `STATUS = CHDIR(NAME)`
1086
1087#### Example
1088```Fortran
1089program chdir_func
1090  character(len=) :: path
1091  integer :: status
1092
1093  call chdir("/tmp")
1094  status = chdir("..")
1095  print *, "status: ", status
1096end program chdir_func
1097```
1098
1099### Non-Standard Intrinsics: IERRNO
1100
1101#### Description
1102`IERRNO()` returns the last system error number, as given by the C `errno` variable.
1103
1104#### Usage and Info
1105
1106- **Standard:** GNU extension
1107- **Class:** function
1108- **Syntax:** `RESULT = IERRNO()`
1109