From 0c40d5a1328b878ffc0cb71ae05b913b9ca8f683 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Fri, 28 Feb 2025 16:32:00 +0100 Subject: [PATCH 01/10] fix(object_based_programming_techniques.md): correct typos A correction based on Beliavsky's reading.[1] [1] https://github.com/fortran-lang/webpage/issues/526 Signed-off-by: Norwid Behrnd --- .../object_based_programming_techniques.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/source/learn/oop_features_in_fortran/object_based_programming_techniques.md b/source/learn/oop_features_in_fortran/object_based_programming_techniques.md index a366b15ccb56..bfb0da458e46 100644 --- a/source/learn/oop_features_in_fortran/object_based_programming_techniques.md +++ b/source/learn/oop_features_in_fortran/object_based_programming_techniques.md @@ -151,9 +151,9 @@ to be aware of: 1. If all type components have the `private` attribute i.e., the type is **opaque** (not a Fortran term), it can only be used if the type declaration is accessed by host association (this is the same as for - nonallocatable/nonpointer components); -2. especially for container-like types, its semantics may be - incompatible with the programmers intentions for how the objects + nonallocatable/nonpointer components). +2. Especially for container-like types, its semantics may be + incompatible with the programmer's intentions for how the objects should be used. Item 2 is illustrated by the above object setups, specifically: @@ -479,7 +479,7 @@ case of polymorphic objects. ### Implementing move semantics Sometimes it may be necessary to make use of move instead of copy -semantics i.e., create a copy of an object and then getting rid of the +semantics i.e., create a copy of an object and then get rid of the original. The simplest way of doing this is to make use of allocatable (scalar or array) objects, From 5e7902b54dff999f4f84d1c1ae3026fead8eab44 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sat, 1 Mar 2025 19:05:42 +0100 Subject: [PATCH 02/10] feat(f95_features.md): initiate work Based on a request on fortran-lang.org,[1] work for a new booklet for the learning section of fortran-lang.org about the features of Fortran 95 starts. The initial step was to fetch the source code (mediawiki synatax) which was converted with Pandoc to GitHub flavored Markdown where possible. This was not possible for the trailing bibliography section of the Wikipedia article (hence left as such in a fenced code block), which however is more an optional "for an additional read, consult ..." rather than a specific literature reference to a particular keyword, or phrase. While GitHub flavored Markdown isn't (yet) MyST Markdown flavor required, it is close enough for the manual edit ahed. Equally a TODO is to build a multipage booklet, i.e. an `index.md` and individual Markdown files about each chapter; this gradually removes `f95_features.md` as an intermediate container file. [1] https://fortran-lang.discourse.group/t/fortran-95-language-features/9263 Signed-off-by: Norwid Behrnd --- source/learn/f95_features/f95_features.md | 2767 +++++++++++++++++++++ 1 file changed, 2767 insertions(+) create mode 100644 source/learn/f95_features/f95_features.md diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md new file mode 100644 index 000000000000..fc235da695fb --- /dev/null +++ b/source/learn/f95_features/f95_features.md @@ -0,0 +1,2767 @@ +# Fortran 95 language features + +This is an overview of **Fortran 95 language features** which is based +upon the standards document[^iso_1539_1997] which has been replaced byi +a newer version.[^iso_1539_2023] Included are the additional features of +TR-15581:Enhanced Data Type Facilities, which have been universally +implemented. Old features that have been superseded by new ones are not +described few of those historic features are used in modern programs +although most have been retained in the language to maintain +[backward_compatibility](https://en.wikipedia.org/wiki/Backward_compatibility). +The additional features of subsequent standards, up to Fortran 2023, are +described in the Fortran 2023 standard document, ISO/IEC +1539-1:2023.[^iso_1539_2023] Some of its new features are still being +implemented in compilers.[^Fortran_plus] Details can also be found in a +range of textbooks, for instance[^OOPvF][^OOPC][^Chapman] and see the\ +list at Fortran Resources.[^Fortran_plus_18] Sources for the description +in the sections below can be found in the standards +documents,[^iso_1539_2023] textbooks[^OOPvF][^OOPC][^Chapman] as well as +the **Bibliography**. + +[^iso_1539_1997]: [ISO/IEC 1539-1:1997](https://www.iso.org/standard/26933.html) + +[^iso_1539_2023]: [ISO/IEC 1539-1:2023](https://www.iso.org/standard/82170.html) + +[^Fortran_plus]: [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/) + +[^OOPvF]: ["Features of Programming Languages"](https://doi.org/10.1017/cbo9780511530111.005), +Object-Oriented Programming via Fortran 90/95, Cambridge University Press, +pp. 56–118. + +[^OOPC]: ["Object-Oriented Programming Concepts"](https://doi.org/10.1017/cbo9780511530111.004), +Object-Oriented Programming via Fortran 90/95, Cambridge University Press, +pp. 36–55 + +[^Chapman]: Chapman, Stephen J. (2004). +[Fortran 90/95 for scientists and engineers](https://www.worldcat.org/title/ocm52465017) +(2nd ed.). Boston: McGraw-Hill Higher Education. ISBN 978-0-07-282575-6. + +[^Fortran_plus_18]: [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/), +p. 18 + +## Language elements + +Fortran is case-insensitive. The convention of writing +Fortran keywords in upper case and all other names in lower case is +adopted in this article; except, by way of contrast, in the input/output +descriptions +(Data +transfer and +Operations on external files). + +### Basics + +The basic component of the Fortran language is its *character set*. Its +members are + +- the letters A ... Z and a ... z (which are equivalent outside a + character context) +- the numerals 0 ... 9 +- the underscore \_ +- the special characters + `= : + blank - * / ( ) [ ] , . $ ' ! " % & ; < > ?` + +Tokens that +have a syntactic meaning to the compiler are built from those +components. There are six classes of tokens: + +| Label | `123` | +|-----------|------------------------------------------------------| +| Constant | `123.456789_long` | +| Keyword | `ALLOCATABLE` | +| Operator | `.add.` | +| Name | `solve_equation` (up to 31 characters, including \_) | +| Separator | `/ ( ) (/ /) [ ] , = => : :: ; %` | + +From the tokens, statements are built. These can be coded using the +new free *source form* which does not require positioning in a rigid +column structure: + +``` fortran +FUNCTION string_concat(s1, s2) ! This is a comment + TYPE (string), INTENT(IN) :: s1, s2 + TYPE (string) string_concat + string_concat%string_data = s1%string_data(1:s1%length) // & + s2%string_data(1:s2%length) ! This is a continuation + string_concat%length = s1%length + s2%length +END FUNCTION string_concat +``` + +Note the trailing comments and the trailing continuation mark. There may +be 39 continuation lines, and 132 characters per line. Blanks are +significant. Where a token or character constant is split across two +lines: + +``` fortran + ... start_of& + &_name + ... 'a very long & + &string' +``` + +a leading `&` on the continued line is also required. + +### Intrinsic data types + +Fortran has five *intrinsic data types*: `INTEGER`, `REAL`, `COMPLEX`, +`LOGICAL` and `CHARACTER`. Each of those types can be additionally +characterized by a *kind*. Kind, basically, defines internal +representation of the type: for the three numeric types, it defines the +precision and range, and for the other two, the specifics of storage +representation. Thus, it is an abstract concept which models the limits +of data types' representation; it is expressed as a member of a set of +whole numbers (e.g. it may be {1, 2, 4, 8} for integers, denoting bytes +of storage), but those values are not specified by the Standard and not +portable. For every type, there is a *default kind*, which is used if no +kind is explicitly specified. For each intrinsic type, there is a +corresponding form of *literal constant*. The numeric types `INTEGER` +and `REAL` can only be signed (there is no concept of sign for type +`COMPLEX`). + +#### Literal constants and kinds + +##### INTEGER + +Integer literal constants of the default kind take the form + +``` fortran +1 0 -999 32767 +10 +``` + +Kind can be defined as a named constant. If the desired range is +±10kind, the portable syntax for defining the appropriate +kind, `two_bytes` is + +``` fortran +INTEGER, PARAMETER :: two_bytes = SELECTED_INT_KIND(4) +``` + +that allows subsequent definition of constants of the form + +``` fortran +-1234_two_bytes +1_two_bytes +``` + +Here, `two_bytes` is the kind type parameter; it can also be an explicit +default integer literal constant, like + +``` fortran +-1234_2 +``` + +but such use is non-portable. + +The KIND function supplies the value of a kind type parameter: + +``` fortran +KIND(1) KIND(1_two_bytes) +``` + +and the `RANGE` function supplies the actual decimal range (so the user +must make the actual mapping to bytes): + +``` fortran +RANGE(1_two_bytes) +``` + +Also, in DATA +(initialization) statements, binary (B), octal (O) and hexadecimal +(Z) constants may be used (often informally referred to as "BOZ +constants"): + +``` fortran +B'01010101' O'01234567' Z'10fa' +``` + +##### REAL + +There are at least two real kindsthe default and one with greater +precision (this replaces + +``` fortran +DOUBLE PRECISION +``` + +). + +``` fortran +SELECTED_REAL_KIND +``` + +functions returns the kind number for desired range and precision; for +at least 9 decimal digits of precision and a range of 10−99 +to 1099, it can be specified as: + +``` fortran +INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(9, 99) +``` + +and literals subsequently specified as + +``` fortran +1.7_long +``` + +Also, there are the intrinsic functions + +``` fortran +KIND(1.7_long) PRECISION(1.7_long) RANGE(1.7_long) +``` + +that give in turn the kind type value, the actual precision (here at +least 9), and the actual range (here at least 99). + +##### COMPLEX + +`COMPLEX` data type is built of two integer or real components: + +``` fortran +(1, 3.7_long) +``` + +##### LOGICAL + +There are only two basic values of logical constants: `.TRUE.` and +`.FALSE.`. Here, there may also be different kinds. Logicals don't have +their own kind inquiry functions, but use the kinds specified for +`INTEGER`s; default kind of `LOGICAL` is the same as of INTEGER. + +``` fortran +.FALSE. .true._one_byte +``` + +and the `KIND` function operates as expected: + +``` fortran +KIND(.TRUE.) +``` + +##### CHARACTER + +The forms of literal constants for `CHARACTER` data type are + +``` fortran +'A string' "Another" 'A "quote"' ''''''' +``` + +(the last being an empty string). Different kinds are allowed (for +example, to distinguish +ASCII and +UNICODE strings), +but not widely supported by compilers. Again, the kind value is given by +the `KIND` function: + +``` fortran +KIND('ASCII') +``` + +#### Number model and intrinsic functions + +The numeric types are based on number models with associated inquiry +functions (whose values are independent of the values of their +arguments; arguments are used only to provide kind). These functions are +important for portable numerical software: + +| | | +|------------------|------------------------------------------| +| `DIGITS(X)` | Number of significant digits | +| `EPSILON(X)` | Almost negligible compared to one (real) | +| `HUGE(X)` | Largest number | +| `MAXEXPONENT(X)` | Maximum model exponent (real) | +| `MINEXPONENT(X)` | Minimum model exponent (real) | +| `PRECISION(X)` | Decimal precision (real, complex) | +| `RADIX(X)` | Base of the model | +| `RANGE(X)` | Decimal exponent range | +| `TINY(X)` | Smallest positive number (real) | + +### Scalar variables + +Scalar variables corresponding to the five intrinsic +types are specified as follows: + +``` fortran +INTEGER(KIND=2) :: i +REAL(KIND=long) :: a +COMPLEX :: current +LOGICAL :: Pravda +CHARACTER(LEN=20) :: word +CHARACTER(LEN=2, KIND=Kanji) :: kanji_word +``` + +where the optional `KIND` parameter specifies a non-default kind, and +the `::` notation delimits the type and attributes from variable name(s) +and their optional initial values, allowing full variable specification +and initialization to be typed in one statement (in previous standards, +attributes and initializers had to be declared in several statements). +While it is not required in above examples (as there are no additional +attributes and initialization), most Fortran-90 programmers acquire the +habit to use it everywhere. + +``` fortran +LEN= +``` + +specifier is applicable only to `CHARACTER`s and specifies the string +length (replacing the older `*len` form). The explicit `KIND=` and +`LEN=` specifiers are optional: + +``` fortran +CHARACTER(2, Kanji) :: kanji_word +``` + +works just as well. + +There are some other interesting character features. Just as a substring +as in + +``` fortran +CHARACTER(80) :: line +... = line(i:i) ! substring +``` + +was previously possible, so now is the substring + +``` fortran +'0123456789'(i:i) +``` + +Also, zero-length strings are allowed: + +``` fortran +line(i:i-1) ! zero-length string +``` + +Finally, there is a set of intrinsic character functions, examples being + +| | | +|------------|------------------------------| +| `ACHAR` | `IACHAR` (for ASCII set) | +| `ADJUSTL` | `ADJUSTR` | +| `LEN_TRIM` | `INDEX(s1, s2, BACK=.TRUE.)` | +| `REPEAT` | `SCAN`(for one of a set) | +| `TRIM` | `VERIFY`(for all of a set) | + +### Derived data types + +For derived data types, the form of the type must be defined first: + +``` fortran +TYPE person + CHARACTER(10) name + REAL age +END TYPE person +``` + +and then, variables of that type can be defined: + +``` fortran +TYPE(person) you, me +``` + +To select components of a derived type, `%` qualifier is used: + +``` fortran +you%age +``` + +Literal constants of derived types have the form +*`TypeName(1stComponentLiteral, 2ndComponentLiteral, ...)`*: + +``` fortran +you = person('Smith', 23.5) +``` + +which is known as a *structure constructor*. Definitions may refer to a +previously defined type: + +``` fortran +TYPE point + REAL x, y +END TYPE point +TYPE triangle + TYPE(point) a, b, c +END TYPE triangle +``` + +and for a variable of type triangle, as in + +``` fortran +TYPE(triangle) t +``` + +each component of type `point` is accessed as + +``` fortran +t%a t%b t%c +``` + +which, in turn, have ultimate components of type real: + +``` fortran +t%a%x t%a%y t%b%x etc. +``` + +(Note that the `%` qualifier was chosen rather than dot (`.`) because of +potential ambiguity with operator notation, like `.OR.`). + +### Implicit and explicit typing + +Unless specified otherwise, all variables starting with letters I, J, K, +L, M and N are default `INTEGER`s, and all others are default `REAL`; +other data types must be explicitly declared. This is known as *implicit +typing* and is a heritage of early FORTRAN days. Those defaults can be +overridden by *`IMPLICIT TypeName (CharacterRange)`* statements, like: + +``` fortran +IMPLICIT COMPLEX(Z) +IMPLICIT CHARACTER(A-B) +IMPLICIT REAL(C-H,N-Y) +``` + +However, it is a good practice to explicitly type all variables, and +this can be forced by inserting the statement + +``` fortran +IMPLICIT NONE +``` + +at the beginning of each program unit. + +### Arrays + +Arrays are considered to be variables in their own right. Every array is +characterized by its +type, +rank, and *shape* (which defines the extents of each +dimension). Bounds of each dimension are by default 1 and *size*, but +arbitrary bounds can be explicitly specified. `DIMENSION` keyword is +optional and considered an attribute; if omitted, the array shape must +be specified after array-variable name. For example, + +``` fortran +REAL:: a(10) +INTEGER, DIMENSION(0:100, -50:50) :: map +``` + +declares two arrays, rank-1 and rank-2, whose elements are in +column-major order. Elements are, for +example, + +``` fortran +a(1) a(i*j) +``` + +and are scalars. The subscripts may be any scalar integer expression. + +*Sections* are parts of the array variables, and are arrays themselves: + +``` fortran +a(i:j) ! rank one +map(i:j, k:l:m) ! rank two +a(map(i, k:l)) ! vector subscript +a(3:2) ! zero length +``` + +Whole arrays and array sections are array-valued objects. Array-valued +constants (constructors) are available, enclosed in `(/ ... /)`: + +``` fortran +(/ 1, 2, 3, 4 /) +(/ ( (/ 1, 2, 3 /), i = 1, 4) /) +(/ (i, i = 1, 9, 2) /) +(/ (0, i = 1, 100) /) +(/ (0.1*i, i = 1, 10) /) +``` + +making use of an implied-DO loop notation. Fortran 2003 allows the use +of brackets: `[1, 2, 3, 4]` and `[([1,2,3], i=1,4)]` instead of the +first two examples above, and many compilers support this now. A derived +data type may, of course, contain array components: + +``` fortran +TYPE triplet + REAL, DIMENSION(3) :: vertex +END TYPE triplet +TYPE(triplet), DIMENSION(4) :: t +``` + +so that + +- ``` fortran + t(2) + ``` + + is a scalar (a structure) + +- ``` fortran + t(2)%vertex + ``` + + is an array component of a scalar + +### Data initialization + +Variables can be given initial values as specified in a specification +statement: + +``` fortran +REAL, DIMENSION(3) :: a = (/ 0.1, 0.2, 0.3 /) +``` + +and a default initial value can be given to the component of a derived +data type: + +``` fortran +TYPE triplet + REAL, DIMENSION(3) :: vertex = 0.0 +END TYPE triplet +``` + +When local variables are initialized within a procedure they implicitly +acquire the SAVE attribute: + +``` fortran +REAL, DIMENSION(3) :: point = (/ 0.0, 1.0, -1.0 /) +``` + +This declaration is equivalent to + +``` fortran +REAL, DIMENSION(3), SAVE :: point = (/ 0.0, 1.0, -1.0 /) +``` + +for local variables within a subroutine or function. The SAVE attribute +causes local variables to retain their value after a procedure call and +then to initialize the variable to the saved value upon returning to the +procedure. + +#### PARAMETER attribute + +A named constant can be specified directly by adding the `PARAMETER` +attribute and the constant values to a type statement: + +``` fortran +REAL, DIMENSION(3), PARAMETER :: field = (/ 0., 1., 2. /) +TYPE(triplet), PARAMETER :: t = triplet( (/ 0., 0., 0. /) ) +``` + +#### DATA statement + +The `DATA` statement can be used for scalars and also for arrays and +variables of derived type. It is also the only way to initialise just +parts of such objects, as well as to initialise to binary, octal or +hexadecimal values: + +``` fortran +TYPE(triplet) :: t1, t2 +DATA t1/triplet( (/ 0., 1., 2. /) )/, t2%vertex(1)/123./ +DATA array(1:64) / 64*0/ +DATA i, j, k/ B'01010101', O'77', Z'ff'/ +``` + +#### Initialization expressions + +The values used in `DATA` and `PARAMETER` statements, or with these +attributes, are constant expressions that may include references to: +array and structure constructors, elemental intrinsic functions with +integer or character arguments and results, and the six transformational +functions `REPEAT, SELECTED_INT_KIND, TRIM, SELECTED_REAL_KIND, RESHAPE` +and `TRANSFER` (see Intrinsic procedures): + +``` fortran +INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(12), & + array(3) = (/ 1, 2, 3 /) +``` + +### Specification expressions + +It is possible to specify details of variables using any non-constant, +scalar, integer expression that may also include inquiry function +references: + +``` fortran +SUBROUTINE s(b, m, c) + USE mod ! contains a + REAL, DIMENSION(:, :) :: b + REAL, DIMENSION(UBOUND(b, 1) + 5) :: x + INTEGER :: m + CHARACTER(LEN=*) :: c + CHARACTER(LEN= m + LEN(c)) :: cc + REAL (SELECTED_REAL_KIND(2*PRECISION(a))) :: z +``` + +## Expressions and assignments + +### Scalar numeric + +The usual arithmetic operators are available `+, -, *, /, **` (given +here in increasing order of precedence). + +Parentheses are used to indicate the order of evaluation where +necessary: + +``` fortran +a*b + c ! * first +a*(b + c) ! + first +``` + +The rules for *scalar numeric* expressions and assignments accommodate +the non-default kinds. Thus, the mixed-mode numeric expression and +assignment rules incorporate different kind type parameters in an +expected way: + +``` fortran +real2 = integer0 + real1 +``` + +converts `integer0` to a real value of the same kind as `real1`; the +result is of same kind, and is converted to the kind of `real2` for +assignment. + +These functions are available for controlled +rounding of +real numbers to integers: + +- `NINT`: round to nearest integer, return integer result +- `ANINT`: round to nearest integer, return real result +- `INT`: truncate (round towards zero), return integer result +- `AINT`: truncate (round towards zero), return real result +- `CEILING`: smallest integral value not less than argument (round up) + (Fortran-90) +- `FLOOR`: largest integral value not greater than argument (round + down) (Fortran-90) + +### Scalar relational operations + +For *scalar relational* operations of numeric types, there is a set of +built-in operators: + +`< <= == /= > >=` +`.LT. .LE. .EQ. .NE. .GT. .GE.` + +(the forms above are new to Fortran-90, and older equivalent forms are +given below them). Example expressions: + +``` fortran +a < b .AND. i /= j ! for numeric variables +flag = a == b ! for logical variable flags +``` + +### Scalar characters + +In the case of *scalar characters* and given + +``` fortran +CHARACTER(8) result +``` + +it is legal to write + +``` fortran +result(3:5) = result(1:3) ! overlap allowed +result(3:3) = result(3:2) ! no assignment of null string +``` + +Concatenation is performed by the operator '//'. + +``` fortran +result = 'abcde'//'123' +filename = result//'.dat' +``` + +### Derived-data types + +No built-in operations (except assignment, defined on component-by +component basis) exist between *derived data types* mutually or with +intrinsic types. The meaning of existing or user-specified operators can +be (re)defined though: + +``` fortran +TYPE string80 + INTEGER length + CHARACTER(80) value +END TYPE string80 +CHARACTER:: char1, char2, char3 +TYPE(string80):: str1, str2, str3 +``` + +we can write + +``` fortran +str3 = str1//str2 ! must define operation +str3 = str1.concat.str2 ! must define operation +char3 = char2//char3 ! intrinsic operator only +str3 = char1 ! must define assignment +``` + +Notice the "overloaded" use of the intrinsic symbol `//` and +the named operator, `.concat.` . A difference between the two cases is +that, for an intrinsic operator token, the usual precedence rules apply, +whereas for named operators, precedence is the highest as a unary +operator or the lowest as a binary one. In + +``` fortran +vector3 = matrix * vector1 + vector2 +vector3 =(matrix .times. vector1) + vector2 +``` + +the two expressions are equivalent only if appropriate parentheses are +added as shown. In each case there must be defined, in a +module, +procedures defining the operator and assignment, and corresponding +operator-procedure association, as follows: + +``` fortran +INTERFACE OPERATOR(//) !Overloads the // operator as invoking string_concat procedure + MODULE PROCEDURE string_concat +END INTERFACE +``` + +The string concatenation function is a more elaborated version of that +shown already in +Basics. Note that +in order to handle the error condition that arises when the two strings +together exceed the preset 80-character limit, it would be safer to use +a subroutine to perform the concatenation (in this case +operator-overloading would not be applicable.) + +``` fortran +MODULE string_type + IMPLICIT NONE + TYPE string80 + INTEGER length + CHARACTER(LEN=80) :: string_data + END TYPE string80 + INTERFACE ASSIGNMENT(=) + MODULE PROCEDURE c_to_s_assign, s_to_c_assign + END INTERFACE + INTERFACE OPERATOR(//) + MODULE PROCEDURE string_concat + END INTERFACE +CONTAINS + SUBROUTINE c_to_s_assign(s, c) + TYPE (string80), INTENT(OUT) :: s + CHARACTER(LEN=*), INTENT(IN) :: c + s%string_data = c + s%length = LEN(c) + END SUBROUTINE c_to_s_assign + SUBROUTINE s_to_c_assign(c, s) + TYPE (string80), INTENT(IN) :: s + CHARACTER(LEN=*), INTENT(OUT) :: c + c = s%string_data(1:s%length) + END SUBROUTINE s_to_c_assign + TYPE(string80) FUNCTION string_concat(s1, s2) + TYPE(string80), INTENT(IN) :: s1, s2 + TYPE(string80) :: s + INTEGER :: n1, n2 + CHARACTER(160) :: ctot + n1 = LEN_TRIM(s1%string_data) + n2 = LEN_TRIM(s2%string_data) + IF (n1+n2 <= 80) then + s%string_data = s1%string_data(1:n1)//s2%string_data(1:n2) + ELSE ! This is an error condition which should be handled - for now just truncate + ctot = s1%string_data(1:n1)//s2%string_data(1:n2) + s%string_data = ctot(1:80) + END IF + s%length = LEN_TRIM(s%string_data) + string_concat = s + END FUNCTION string_concat +END MODULE string_type + +PROGRAM main + USE string_type + TYPE(string80) :: s1, s2, s3 + CALL c_to_s_assign(s1,'My name is') + CALL c_to_s_assign(s2,' Linus Torvalds') + s3 = s1//s2 + WRITE(*,*) 'Result: ',s3%string_data + WRITE(*,*) 'Length: ',s3%length +END PROGRAM +``` + +Defined operators such as these are required for the expressions that +are allowed also in structure constructors (see +Derived-data types): + +``` fortran +str1 = string(2, char1//char2) ! structure constructor +``` + +### Arrays + +In the case of arrays then, as long as they are of the same shape +(conformable), operations and assignments are extended in an obvious +way, on an element-by-element basis. For example, given declarations of + +``` fortran +REAL, DIMENSION(10, 20) :: a, b, c +REAL, DIMENSION(5) :: v, w +LOGICAL flag(10, 20) +``` + +it can be written: + +``` fortran +a = b ! whole array assignment +c = a/b ! whole array division and assignment +c = 0. ! whole array assignment of scalar value +w = v + 1. ! whole array addition to scalar value +w = 5/v + a(1:5, 5) ! array division, and addition to section +flag = a==b ! whole array relational test and assignment +c(1:8, 5:10) = a(2:9, 5:10) + b(1:8, 15:20) ! array section addition and assignment +v(2:5) = v(1:4) ! overlapping section assignment +``` + +The order of expression evaluation is not specified in order to allow +for optimization on parallel and vector machines. Of course, any +operators for arrays of derived type must be defined. + +Some real intrinsic functions that are useful for numeric computations +are + +- ``` fortran + CEILING + ``` + +- ``` fortran + FLOOR + ``` + +- ``` fortran + MODULO + ``` + + (also integer) + +- ``` fortran + EXPONENT + ``` + +- ``` fortran + FRACTION + ``` + +- ``` fortran + NEAREST + ``` + +- ``` fortran + RRSPACING + ``` + +- ``` fortran + SPACING + ``` + +- ``` fortran + SCALE + ``` + +- ``` fortran + SET_EXPONENT + ``` + +These are array valued for array arguments (elemental), like all +FORTRAN 77 +functions (except LEN): + +- ``` fortran + INT + ``` + +- ``` fortran + REAL + ``` + +- ``` fortran + CMPLX + ``` + +- ``` fortran + AINT + ``` + +- ``` fortran + ANINT + ``` + +- ``` fortran + NINT + ``` + +- ``` fortran + ABS + ``` + +- ``` fortran + MOD + ``` + +- ``` fortran + SIGN + ``` + +- ``` fortran + DIM + ``` + +- ``` fortran + MAX + ``` + +- ``` fortran + MIN + ``` + +Powers, logarithms, and trigonometric functions + +- ``` fortran + SQRT + ``` + +- ``` fortran + EXP + ``` + +- ``` fortran + LOG + ``` + +- ``` fortran + LOG10 + ``` + +- ``` fortran + SIN + ``` + +- ``` fortran + COS + ``` + +- ``` fortran + TAN + ``` + +- ``` fortran + ASIN + ``` + +- ``` fortran + ACOS + ``` + +- ``` fortran + ATAN + ``` + +- ``` fortran + ATAN2 + ``` + +- ``` fortran + SINH + ``` + +- ``` fortran + COSH + ``` + +- ``` fortran + TANH + ``` + +Complex numbers: + +- ``` fortran + AIMAG + ``` + +- ``` fortran + CONJG + ``` + +The following are for characters: + +- ``` fortran + LGE + ``` + +- ``` fortran + LGT + ``` + +- ``` fortran + LLE + ``` + +- ``` fortran + LLT + ``` + +- ``` fortran + ICHAR + ``` + +- ``` fortran + CHAR + ``` + +- ``` fortran + INDEX + ``` + +## Control statements + +### Branching and conditions + +The simple `GO TO` *label* exists, but is usually avoided in most cases, +a more specific branching construct will accomplish the same logic with +more clarity. + +The simple conditional test is the `IF` statement: + +``` fortran +IF (a > b) x = y +``` + +A full-blown `IF` construct is illustrated by + +``` fortran +IF (i < 0) THEN + IF (j < 0) THEN + x = 0. + ELSE + z = 0. + END IF +ELSE IF (k < 0) THEN + z = 1. +ELSE + x = 1. +END IF +``` + +### CASE construct + +The `CASE` construct is a replacement for the computed `GOTO`, but is +better structured and does not require the use of statement labels: + +``` fortran +SELECT CASE (number) ! number of type integer +CASE (:-1) ! all values below 0 + n_sign = -1 +CASE (0) ! only 0 + n_sign = 0 +CASE (1:) ! all values above 0 + n_sign = 1 +END SELECT +``` + +Each `CASE` selector list may contain a list and/or range of integers, +character or logical constants, whose values may not overlap within or +between selectors: + +``` fortran +CASE (1, 2, 7, 10:17, 23) +``` + +A default is available: + +``` fortran +CASE DEFAULT +``` + +There is only one evaluation, and only one match. + +### DO construct + +A simplified but sufficient form of the `DO` construct is illustrated by + +``` fortran +outer: DO +inner: DO i = j, k, l ! from j to k in steps of l (l is optional) + : + IF (...) CYCLE + : + IF (...) EXIT outer + : + END DO inner + END DO outer +``` + +where we note that loops may be optionally named so that any EXIT or +CYCLE statement may specify which loop is meant. + +Many, but not all, simple loops can be replaced by array expressions and +assignments, or by new intrinsic functions. For instance + +``` fortran +tot = 0. +DO i = m, n + tot = tot + a(i) +END DO +``` + +becomes simply + +``` fortran +tot = SUM( a(m:n) ) +``` + +## Program units and procedures + +### Definitions + +In order to discuss this topic we need some definitions. In logical +terms, an executable program consists of one *main program* and zero or +more *subprograms* (or *procedures*) - these do something. Subprograms +are either *functions*or *subroutines*, which are either *external, +internal* or *module* subroutines. (External subroutines are what we +knew from FORTRAN 77.) + +From an organizational point of view, however, a complete program +consists of *program units*. These are either *main programs, external +subprograms* or *modules* and can be separately compiled. + +An example of a main (and complete) program is + +``` fortran +PROGRAM test + PRINT *, 'Hello world!' +END PROGRAM test +``` + +An example of a main program and an external subprogram, forming an +executable program, is + +``` fortran +PROGRAM test + CALL print_message +END PROGRAM test +SUBROUTINE print_message + PRINT *, 'Hello world!' +END SUBROUTINE print_message +``` + +The form of a function is + +``` fortran +FUNCTION name(arg1, arg2) ! zero or more arguments + : + name = ... + : +END FUNCTION name +``` + +The form of reference of a function is + +``` fortran +x = name(a, b) +``` + +### Internal procedures + +An internal subprogram is one *contained* in another (at a maximum of +one level of nesting) and provides a replacement for the statement +function: + +``` fortran +SUBROUTINE outer + REAL x, y + : +CONTAINS + SUBROUTINE inner + REAL y + y = x + 1. + : + END SUBROUTINE inner ! SUBROUTINE mandatory +END SUBROUTINE outer +``` + +We say that `outer` is the *host* of `inner`, and that `inner` obtains +access to entities in `outer` by *host association* (e.g. to `x`), +whereas `y` is a *local* variable to `inner`. + +The *scope* of a named entity is a *scoping unit*, here `outer` less +`inner`, and `inner`. + +The names of program units and external procedures are *global*, and the +names of implied-DO variables have a scope of the statement that +contains them. + +### Modules + +Modules are used to package + +- global data (replaces COMMON and BLOCK DATA from Fortran 77); +- type definitions (themselves a scoping unit); +- subprograms (which among other things replaces the use of ENTRY from + Fortran 77); +- interface blocks (another scoping unit, see + Interface blocks); +- namelist groups (see any textbook). + +An example of a module containing a type definition, interface block and +function subprogram is + +``` fortran +MODULE interval_arithmetic + TYPE interval + REAL lower, upper + END TYPE interval + INTERFACE OPERATOR(+) + MODULE PROCEDURE add_intervals + END INTERFACE + : +CONTAINS + FUNCTION add_intervals(a,b) + TYPE(interval), INTENT(IN) :: a, b + TYPE(interval) add_intervals + add_intervals%lower = a%lower + b%lower + add_intervals%upper = a%upper + b%upper + END FUNCTION add_intervals ! FUNCTION mandatory + : +END MODULE interval_arithmetic +``` + +and the simple statement + +``` fortran + +USE interval_arithmetic +``` + +provides *use association* to all the module's entities. Module +subprograms may, in turn, contain internal subprograms. + +### Controlling accessibility + +The `PUBLIC` and `PRIVATE` attributes are used in specifications in +modules to limit the scope of entities. The attribute form is + +``` fortran +REAL, PUBLIC :: x, y, z ! default +INTEGER, PRIVATE :: u, v, w +``` + +and the statement form is + +``` fortran +PUBLIC :: x, y, z, OPERATOR(.add.) +PRIVATE :: u, v, w, ASSIGNMENT(=), OPERATOR(*) +``` + +The statement form has to be used to limit access to operators, and can +also be used to change the overall default: + +``` fortran +PRIVATE ! sets default for module +PUBLIC :: only_this +``` + +For derived types there are three possibilities: the type and its +components are all PUBLIC, the type is PUBLIC and its components PRIVATE +(the type only is visible and one can change its details easily), or all +of it is PRIVATE (for internal use in the module only): + +``` fortran +MODULE mine + PRIVATE + TYPE, PUBLIC :: list + REAL x, y + TYPE(list), POINTER :: next + END TYPE list + TYPE(list) :: tree + : +END MODULE mine +``` + +The `USE` statement's purpose is to gain access to entities in a module. +It has options to resolve name clashes if an imported name is the same +as a local one: + +``` fortran +USE mine, local_list => list +``` + +or to restrict the used entities to a specified set: + +``` fortran +USE mine, ONLY : list +``` + +These may be combined: + +``` fortran +USE mine, ONLY : local_list => list +``` + +### Arguments + +We may specify the intent of dummy arguments: + +``` fortran +SUBROUTINE shuffle (ncards, cards) + INTEGER, INTENT(IN) :: ncards + INTEGER, INTENT(OUT), DIMENSION(ncards) :: cards +``` + +Also, INOUT is possible: here the actual argument must be a variable +(unlike the default case where it may be a constant). + +Arguments may be optional: + +``` fortran +SUBROUTINE mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstart) + REAL, OPTIONAL, DIMENSION :: upper, lower + : + IF (PRESENT(lower)) THEN ! test for presence of actual argument + : +``` + +allows us to call `mincon` by + +``` fortran +CALL mincon (n, f, x, upper) +``` + +Arguments may be keyword rather than positional (which come first): + +``` fortran +CALL mincon(n, f, x, equalities=0, xstart=x0) +``` + +Optional and keyword arguments are handled by explicit interfaces, that +is with internal or module procedures or with interface blocks. + +### Interface blocks + +Any reference to an internal or module subprogram is through an +interface that is 'explicit' (that is, the compiler can see all the +details). A reference to an external (or dummy) procedure is usually +'implicit' (the compiler assumes the details). However, we can provide +an explicit interface in this case too. It is a copy of the header, +specifications and END statement of the procedure concerned, either +placed in a module or inserted directly: + +``` fortran +REAL FUNCTION minimum(a, b, func) + ! returns the minimum value of the function func(x) + ! in the interval (a,b) + REAL, INTENT(in) :: a, b + INTERFACE + REAL FUNCTION func(x) + REAL, INTENT(IN) :: x + END FUNCTION func + END INTERFACE + REAL f,x + : + f = func(x) ! invocation of the user function. + : +END FUNCTION minimum +``` + +An explicit interface is obligatory for + +- optional and keyword arguments; +- POINTER and TARGET arguments (see + Pointers); +- POINTER function result; +- new-style array arguments and array functions + (Array + handling). + +It allows full checks at compile time between actual and dummy +arguments. + +**In general, the best way to ensure that a procedure interface is +explicit is either to place the procedure concerned in a module or to +use it as an internal procedure.** + +### Overloading and generic interfaces + +Interface blocks provide the mechanism by which we are able to define +generic names for specific procedures: + +``` fortran +INTERFACE gamma ! generic name + FUNCTION sgamma(X) ! specific name + REAL (SELECTED_REAL_KIND( 6)) sgamma, x + END + FUNCTION dgamma(X) ! specific name + REAL (SELECTED_REAL_KIND(12)) dgamma, x + END +END INTERFACE +``` + +where a given set of specific names corresponding to a generic name must +all be of functions or all of subroutines. If this interface is within a +module, then it is simply + +``` fortran +INTERFACE gamma + MODULE PROCEDURE sgamma, dgamma +END INTERFACE +``` + +We can use existing names, e.g. SIN, and the compiler sorts out the +correct association. + +We have already seen the use of interface blocks for defined operators +and assignment (see +Modules). + +### Recursion + +Indirect recursion is useful for multi-dimensional integration. For + +``` fortran +volume = integrate(fy, ybounds) +``` + +We might have + +``` fortran +RECURSIVE FUNCTION integrate(f, bounds) + ! Integrate f(x) from bounds(1) to bounds(2) + REAL integrate + INTERFACE + FUNCTION f(x) + REAL f, x + END FUNCTION f + END INTERFACE + REAL, DIMENSION(2), INTENT(IN) :: bounds + : +END FUNCTION integrate +``` + +and to integrate *f(x, y)* over a rectangle: + +``` fortran +FUNCTION fy(y) + USE func ! module func contains function f + REAL fy, y + yval = y + fy = integrate(f, xbounds) +END +``` + +Direct recursion is when a procedure calls itself, as in + +``` fortran +RECURSIVE FUNCTION factorial(n) RESULT(res) + INTEGER res, n + IF(n.EQ.0) THEN + res = 1 + ELSE + res = n*factorial(n-1) + END IF +END +``` + +Here, we note the `RESULT` clause and termination test. + +### Pure procedures + +This is a feature for parallel computing. + +In the FORALL statement and +construct, any side effects in a function can impede optimization on +a parallel processor the order of execution of the assignments could +affect the results. To control this situation, we add the `PURE` keyword +to the `SUBROUTINE` or `FUNCTION` statementan assertion that the +procedure (expressed simply): + +- alters no global variable, +- performs no I/O, +- has no saved variables (variables with the `SAVE` attribute that + retains values between invocations), and +- for functions, does not alter any of its arguments. + +A compiler can check that this is the case, as in + +``` fortran +PURE FUNCTION calculate (x) +``` + +All the intrinsic functions are pure. + +## Array handling + +Array handling is included in Fortran for two main reasons: + +- the notational convenience it provides, bringing the code closer to + the underlying mathematical form; +- for the additional optimization opportunities it gives compilers + (although there are plenty of opportunities for degrading + optimization too!). + +At the same time, major extensions of the functionality in this area +have been added. We have already met whole arrays above +#Arrays 1 and +here +#Arrays 2 - +now we develop the theme. + +### Zero-sized arrays + +A zero-sized array is handled by Fortran as a legitimate object, without +special coding by the programmer. Thus, in + +``` fortran +DO i = 1,n + x(i) = b(i) / a(i, i) + b(i+1:n) = b(i+1:n) - a(i+1:n, i) * x(i) +END DO +``` + +no special code is required for the final iteration where `i = n`. We +note that a zero-sized array is regarded as being defined; however, an +array of shape (0,2) is not conformable with one of shape (0,3), whereas + +``` fortran +x(1:0) = 3 +``` + +is a valid 'do nothing' statement. + +### Assumed-shape arrays + +These are an extension and replacement for assumed-size arrays. Given an +actual argument like: + +``` fortran +REAL, DIMENSION(0:10, 0:20) :: a + : +CALL sub(a) +``` + +the corresponding dummy argument specification defines only the type and +rank of the array, not its shape. This information has to be made +available by an explicit interface, often using an interface block (see +Interface blocks). Thus we write just + +``` fortran +SUBROUTINE sub(da) + REAL, DIMENSION(:, :) :: da +``` + +and this is as if `da` were dimensioned (11,21). However, we can specify +any lower bound and the array maps accordingly. + +``` fortran +REAL, DIMENSION(0:, 0:) :: da +``` + +The shape, not bounds, is passed, where the default lower bound is 1 and +the default upper bound is the corresponding extent. + +### Automatic arrays + +A partial replacement for the uses to which `EQUIVALENCE` was put is +provided by this facility, useful for local, temporary arrays, as in + +``` fortran +SUBROUTINE swap(a, b) + REAL, DIMENSION(:) :: a, b + REAL, DIMENSION(SIZE(a)) :: work + work = a + a = b + b = work +END SUBROUTINE swap +``` + +The actual storage is typically maintained on a stack. + +### ALLOCATABLE and ALLOCATE + +Fortran provides dynamic allocation of storage; it relies on a heap +storage mechanism (and replaces another use of `EQUIVALENCE`). An +example for establishing a work array for a whole program is + +``` fortran +MODULE work_array + INTEGER n + REAL, DIMENSION(:,:,:), ALLOCATABLE :: work +END MODULE +PROGRAM main + USE work_array + READ (input, *) n + ALLOCATE(work(n, 2*n, 3*n), STAT=status) + : + DEALLOCATE (work) +``` + +The work array can be propagated through the whole program via a `USE` +statement in each program unit. We may specify an explicit lower bound +and allocate several entities in one statement. To free dead storage we +write, for instance, + +``` fortran +DEALLOCATE(a, b) +``` + +Deallocation of arrays is automatic when they go out of scope. + +### Elemental operations, assignments and procedures + +We have already met whole array assignments and operations: + +``` fortran +REAL, DIMENSION(10) :: a, b +a = 0. ! scalar broadcast; elemental assignment +b = SQRT(a) ! intrinsic function result as array object +``` + +In the second assignment, an intrinsic function returns an array-valued +result for an array-valued argument. We can write array-valued functions +ourselves (they require an explicit interface): + +``` fortran +PROGRAM test + REAL, DIMENSION(3) :: a = (/ 1., 2., 3./), & + b = (/ 2., 2., 2. /), r + r = f(a, b) + PRINT *, r +CONTAINS + FUNCTION f(c, d) + REAL, DIMENSION(:) :: c, d + REAL, DIMENSION(SIZE(c)) :: f + f = c*d ! (or some more useful function of c and d) + END FUNCTION f +END PROGRAM test +``` + +Elemental procedures are specified with scalar dummy arguments that may +be called with array actual arguments. In the case of a function, the +shape of the result is the shape of the array arguments. + +Most intrinsic functions are elemental and Fortran 95 extends this +feature to non-intrinsic procedures, thus providing the effect of +writing, in Fortran 90, 22 different versions, for ranks 0-0, 0-1, 1-0, +1-1, 0-2, 2-0, 2-2, ... 7-7, and is further an aid to optimization on +parallel processors. An elemental procedure must be pure. + +``` fortran +ELEMENTAL SUBROUTINE swap(a, b) + REAL, INTENT(INOUT) :: a, b + REAL :: work + work = a + a = b + b = work +END SUBROUTINE swap +``` + +The dummy arguments cannot be used in specification expressions (see +above) except as arguments to certain intrinsic +functions (`BIT_SIZE`, `KIND`, `LEN`, and the numeric inquiry ones, (see +below). + +### WHERE + +Often, we need to mask an assignment. This we can do using the `WHERE`, +either as a statement: + +``` fortran +WHERE (a /= 0.0) a = 1.0/a ! avoid division by 0 +``` + +(note: the test is element-by-element, not on whole array), or as a +construct: + +``` fortran +WHERE (a /= 0.0) + a = 1.0/a + b = a ! all arrays same shape +END WHERE +``` + +or + +``` fortran +WHERE (a /= 0.0) + a = 1.0/a +ELSEWHERE + a = HUGE(a) +END WHERE +``` + +Further: + +- it is permitted to mask not only the `WHERE` statement of the + `WHERE` construct, but also any `ELSEWHERE` statement that it + contains; +- a `WHERE` construct may contain any number of masked `ELSEWHERE` + statements but at most one `ELSEWHERE` statement without a mask, and + that must be the final one; +- `WHERE` constructs may be nested within one another, just `FORALL` + constructs; +- a `WHERE` assignment statement is permitted to be a defined + assignment, provided that it is elemental; +- a `WHERE` construct may be named in the same way as other + constructs. + +### The FORALL statement and construct + +When a `DO` construct is executed, each successive iteration is +performed in order and one after the otheran impediment to optimization +on a parallel processor. + +``` fortran +FORALL(i = 1:n) a(i, i) = x(i) +``` + +where the individual assignments may be carried out in any order, and +even simultaneously. The `FORALL` may be considered to be an array +assignment expressed with the help of indices. + +``` fortran +FORALL(i=1:n, j=1:n, y(i,j)/=0.) x(j,i) = 1.0/y(i,j) +``` + +with masking condition. + +The `FORALL` construct allows several assignment statements to be +executed in order. + +``` fortran +a(2:n-1,2:n-1) = a(2:n-1,1:n-2) + a(2:n-1,3:n) + a(1:n-2,2:n-1) + a(3:n,2:n-1) +b(2:n-1,2:n-1) = a(2:n-1,2:n-1) +``` + +is equivalent to the array assignments + +``` fortran +FORALL(i = 2:n-1, j = 2:n-1) + a(i,j) = a(i,j-1) + a(i,j+1) + a(i-1,j) + a(i+1,j) + b(i,j) = a(i,j) +END FORALL +``` + +The `FORALL` version is more readable. + +Assignment in a `FORALL` is like an array assignment: as if all the +expressions were evaluated in any order, held in temporary storage, then +all the assignments performed in any order. The first statement must +fully complete before the second can begin. + +A `FORALL` may be nested, and may include a `WHERE`. Procedures +referenced within a `FORALL` must be pure. + +### Array elements + +For a simple case, given + +``` fortran +REAL, DIMENSION(100, 100) :: a +``` + +we can reference a single element as, for instance, `a(1, 1)`. For a +derived-data type like + +``` fortran +TYPE fun_del + REAL u + REAL, DIMENSION(3) :: du +END TYPE fun_del +``` + +we can declare an array of that type: + +``` fortran +TYPE(fun_del), DIMENSION(10, 20) :: tar +``` + +and a reference like + +``` fortran +tar(n, 2) +``` + +is an element (a scalar!) of type fun_del, but + +``` fortran +tar(n, 2)%du +``` + +is an array of type real, and + +``` fortran +tar(n, 2)%du(2) +``` + +is an element of it. The basic rule to remember is that an array element +always has a subscript or subscripts qualifying at least the last name. + +### Array subobjects (sections) + +The general form of subscript for an array section is + +` [`*`lower`*`] : [`*`upper`*`] [:`*`stride`*`]` + +(where \[ \] indicates an optional item) as in + +``` fortran +REAL a(10, 10) +a(i, 1:n) ! part of one row +a(1:m, j) ! part of one column +a(i, : ) ! whole row +a(i, 1:n:3) ! every third element of row +a(i, 10:1:-1) ! row in reverse order +a( (/ 1, 7, 3, 2 /), 1) ! vector subscript +a(1, 2:11:2) ! 11 is legal as not referenced +a(:, 1:7) ! rank two section +``` + +Note that a vector subscript with duplicate values cannot appear on the +left-hand side of an assignment as it would be ambiguous. Thus, + +``` fortran +b( (/ 1, 7, 3, 7 /) ) = (/ 1, 2, 3, 4 /) +``` + +is illegal. Also, a section with a vector subscript must not be supplied +as an actual argument to an `OUT` or `INOUT` dummy argument. Arrays of +arrays are not allowed: + +``` fortran +tar%du ! illegal +``` + +We note that a given value in an array can be referenced both as an +element and as a section: + +``` fortran +a(1, 1) ! scalar (rank zero) +a(1:1, 1) ! array section (rank one) +``` + +depending on the circumstances or requirements. By qualifying objects of +derived type, we obtain elements or sections depending on the rule +stated earlier: + +``` fortran +tar%u ! array section (structure component) +tar(1, 1)%u ! component of an array element +``` + +### Arrays intrinsic functions + +***Vector and matrix multiply*** + +| | | +|---------------|----------------------------------| +| `DOT_PRODUCT` | Dot product of 2 rank-one arrays | +| `MATMUL` | Matrix multiplication | + +***Array reduction*** + +| | | +|-----------|-------------------------------------------------------------| +| `ALL` | True if all values are true | +| `ANY` | True if any value is true. Example: `IF (ANY( a > b)) THEN` | +| `COUNT` | Number of true elements in array | +| `MAXVAL` | Maximum value in an array | +| `MINVAL` | Minimum value in an array | +| `PRODUCT` | Product of array elements | +| `SUM` | Sum of array elements | + +***Array inquiry*** + +| | | +|-------------|--------------------------------------| +| `ALLOCATED` | Array allocation status | +| `LBOUND` | Lower dimension bounds of an array | +| `SHAPE` | Shape of an array (or scalar) | +| `SIZE` | Total number of elements in an array | +| `UBOUND` | Upper dimension bounds of an array | + +***Array construction*** + +| | | +|----------|------------------------------------------------------| +| `MERGE` | Merge under mask | +| `PACK` | Pack an array into an array of rank one under a mask | +| `SPREAD` | Replicate array by adding a dimension | +| `UNPACK` | Unpack an array of rank one into an array under mask | + +***Array reshape*** + +| | | +|-----------|------------------| +| `RESHAPE` | Reshape an array | + +***Array manipulation*** + +| | | +|-------------|-----------------------------------| +| `CSHIFT` | Circular shift | +| `EOSHIFT` | End-off shift | +| `TRANSPOSE` | Transpose of an array of rank two | + +***Array location*** + +| | | +|----------|---------------------------------------------| +| `MAXLOC` | Location of first maximum value in an array | +| `MINLOC` | Location of first minimum value in an array | + + +## Pointers + +### Basics + +Pointers are variables with the `POINTER` attribute; they are not a +distinct data type (and so no 'pointer arithmetic' is possible). + +``` fortran +REAL, POINTER :: var +``` + +They are conceptually a descriptor listing the attributes of the objects +(targets) that the pointer may point to, and the address, if any, of a +target. They have no associated storage until it is allocated or +otherwise associated (by pointer assignment, see +below): + +``` fortran +ALLOCATE (var) +``` + +and they are dereferenced automatically, so no special symbol required. +In + +``` fortran +var = var + 2.3 +``` + +the value of the target of var is used and modified. Pointers cannot be +transferred via I/O. The statement + +``` fortran +WRITE *, var +``` + +writes the value of the target of var and not the pointer descriptor +itself. + +A pointer can point to another pointer, and hence to its target, or to a +static object that has the `TARGET` attribute: + +``` fortran +REAL, POINTER :: object +REAL, TARGET :: target_obj +var => object ! pointer assignment +var => target_obj +``` + +but they are strongly typed: + +``` fortran +INTEGER, POINTER :: int_var +var => int_var ! illegal - types must match +``` + +and, similarly, for arrays the ranks as well as the type must agree. + +A pointer can be a component of a derived type: + +``` fortran +TYPE entry ! type for sparse matrix + REAL :: value + INTEGER :: index + TYPE(entry), POINTER :: next ! note recursion +END TYPE entry +``` + +and we can define the beginning of a linked chain of such entries: + +``` fortran +TYPE(entry), POINTER :: chain +``` + +After suitable allocations and definitions, the first two entries could +be addressed as + +``` fortran +chain%value chain%next%value +chain%index chain%next%index +chain%next chain%next%next +``` + +but we would normally define additional pointers to point at, for +instance, the first and current entries in the list. + +### Association + +A pointer's association status is one of Some care has to be taken not +to leave a pointer 'dangling' by use of `DEALLOCATE` on its target +without nullifying any other pointer referring to it. + +The intrinsic function `ASSOCIATED` can test the association status of a +defined pointer: + +``` fortran +IF (ASSOCIATED(ptr)) THEN +``` + +or between a defined pointer and a defined target (which may, itself, be +a pointer): + +``` fortran +IF (ASSOCIATED(ptr, target)) THEN +``` + +An alternative way to initialize a pointer, also in a specification +statement, is to use the `NULL` function: + +``` fortran +REAL, POINTER, DIMENSION(:) :: vector => NULL() ! compile time +vector => NULL() ! run time +``` + +### Pointers in expressions and assignments + +For intrinsic types we can 'sweep' pointers over different sets of +target data using the same code without any data movement. Given the +matrix manipulation *y = B C z*, we can write the following code +(although, in this case, the same result could be achieved more simply +by other means): + +``` fortran +REAL, TARGET :: b(10,10), c(10,10), r(10), s(10), z(10) +REAL, POINTER :: a(:,:), x(:), y(:) +INTEGER mult +: +DO mult = 1, 2 + IF (mult == 1) THEN + y => r ! no data movement + a => c + x => z + ELSE + y => s ! no data movement + a => b + x => r + END IF + y = MATMUL(a, x) ! common calculation +END DO +``` + +For objects of derived type we have to distinguish between pointer and +normal assignment. In + +``` fortran +TYPE(entry), POINTER :: first, current +: +first => current +``` + +the assignment causes first to point at current, whereas + +``` fortran +first = current +``` + +causes current to overwrite first and is equivalent to + +``` fortran +first%value = current%value +first%index = current%index +first%next => current%next +``` + +### Pointer arguments + +If an actual argument is a pointer then, if the dummy argument is also a +pointer, + +- it must have same rank, +- it receives its association status from the actual argument, +- it returns its final association status to the actual argument + (note: the target may be undefined!), +- it may not have the `INTENT` attribute (it would be ambiguous), +- it requires an interface block. + +If the dummy argument is not a pointer, it becomes associated with the +target of the actual argument: + +``` fortran + REAL, POINTER :: a (:,:) + : + ALLOCATE (a(80, 80)) + : + CALL sub(a) + : +SUBROUTINE sub(c) + REAL c(:, :) +``` + +### Pointer functions + +Function results may also have the `POINTER` attribute; this is useful +if the result size depends on calculations performed in the function, as +in + +``` fortran +USE data_handler +REAL x(100) +REAL, POINTER :: y(:) +: +y => compact(x) +``` + +where the module data_handler contains + +``` fortran +FUNCTION compact(x) + REAL, POINTER :: compact(:) + REAL x(:) + ! A procedure to remove duplicates from the array x + INTEGER n + : ! Find the number of distinct values, n + ALLOCATE(compact(n)) + : ! Copy the distinct values into compact +END FUNCTION compact +``` + +The result can be used in an expression (but must be associated with a +defined target). + +### Arrays of pointers + +These do not exist as such: given + +``` fortran +TYPE(entry) :: rows(n) +``` + +then + +``` fortran +rows%next ! illegal +``` + +would be such an object, but with an irregular storage pattern. For this +reason they are not allowed. However, we can achieve the same effect by +defining a derived data type with a pointer as its sole component: + +``` fortran +TYPE row + REAL, POINTER :: r(:) +END TYPE +``` + +and then defining arrays of this data type + +``` fortran +TYPE(row) :: s(n), t(n) +``` + +where the storage for the rows can be allocated by, for instance, + +``` fortran +DO i = 1, n + ALLOCATE (t(i)%r(1:i)) ! Allocate row i of length i +END DO +``` + +The array assignment + +``` fortran +s = t +``` + +is then equivalent to the pointer assignments + +``` fortran +s(i)%r => t(i)%r +``` + +for all components. + +### Pointers as dynamic aliases + +Given an array + +``` fortran +REAL, TARGET :: table(100,100) +``` + +that is frequently referenced with the fixed subscripts + +``` fortran +table(m:n, p:q) +``` + +these references may be replaced by + +``` fortran +REAL, DIMENSION(:, :), POINTER :: window + : +window => table(m:n, p:q) +``` + +The subscripts of window are + +``` fortran +1:n-m+1, 1:q-p+1 +``` + +. Similarly, for + +``` fortran +tar%u +``` + +(as defined in +already), +we can use, say, + +``` fortran +taru => tar%u +``` + +to point at all the u components of tar, and subscript it as + +``` fortran +taru(1, 2) +``` + +The subscripts are as those of tar itself. (This replaces yet more of +`EQUIVALENCE`.) + +In the pointer association + +``` fortran +pointer => array_expression +``` + +the lower bounds for `pointer` are determined as if `lbound` was applied +to `array_expression`. Thus, when a pointer is assigned to a whole array +variable, it inherits the lower bounds of the variable, otherwise, the +lower bounds default to 1. + +Fortran +2003 allows specifying arbitrary lower bounds on pointer +association, like + +``` fortran +window(r:,s:) => table(m:n,p:q) +``` + +so that the bounds of `window` become `r:r+n-m,s:s+q-p`. +Fortran 95 +does not have this feature; however, it can be simulated using the +following trick (based on the pointer association rules for assumed +shape array dummy arguments): + +``` fortran +FUNCTION remap_bounds2(lb1,lb2,array) RESULT(ptr) + INTEGER, INTENT(IN) :: lb1,lb2 + REAL, DIMENSION(lb1:,lb2:), INTENT(IN), TARGET :: array + REAL, DIMENSION(:,:), POINTER :: ptr + ptr => array +END FUNCTION + : +window => remap_bounds2(r,s,table(m:n,p:q)) +``` + +The source code of an extended example of the use of pointers to support +a data structure is in +[pointer.f90](ftp://ftp.numerical.rl.ac.uk/pub/MRandC/pointer.f90). + + +## Intrinsic procedures + +Most of the intrinsic functions have already been mentioned. Here, we +deal only with their general classification and with those that have so +far been omitted. All intrinsic procedures can be used with keyword +arguments: + +``` fortran +CALL DATE_AND_TIME (TIME=t) +``` + +and many have optional arguments. + +The intrinsic procedures are grouped into four categories: + +1. elemental - work on scalars or arrays, e.g. `ABS(a)`; +2. inquiry - independent of value of argument (which may be undefined), + e.g. `PRECISION(a)`; +3. transformational - array argument with array result of different + shape, e.g. `RESHAPE(a, b)`; +4. subroutines, e.g. `SYSTEM_CLOCK`. + +The procedures not already introduced are + +Bit inquiry + +| | | +|------------|-----------------------------| +| `BIT_SIZE` | Number of bits in the model | + +Bit manipulation + +| | | +|----------|--------------------| +| `BTEST` | Bit testing | +| `IAND` | Logical AND | +| `IBCLR` | Clear bit | +| `IBITS` | Bit extraction | +| `IBSET` | Set bit | +| `IEOR` | Exclusive OR | +| `IOR` | Inclusive OR | +| `ISHFT` | Logical shift | +| `ISHFTC` | Circular shift | +| `NOT` | Logical complement | + +Transfer function, as in + +``` fortran +INTEGER :: i = TRANSFER('abcd', 0) +``` + +(replaces part of EQUIVALENCE) + +Subroutines + +| | | +|-----------------|-----------------------------------| +| `DATE_AND_TIME` | Obtain date and/or time | +| `MVBITS` | Copies bits | +| `RANDOM_NUMBER` | Returns pseudorandom numbers | +| `RANDOM_SEED` | Access to seed | +| `SYSTEM_CLOCK` | Access to system clock | +| `CPU_TIME` | Returns processor time in seconds | + + +## Data transfer + +### Formatted input/output + +These examples illustrate various forms of I/O lists with some simple +formats (see +below): + +``` fortran +INTEGER :: i +REAL, DIMENSION(10) :: a +CHARACTER(len=20) :: word +PRINT "(i10)", i +PRINT "(10f10.3)", a +PRINT "(3f10.3)", a(1),a(2),a(3) +PRINT "(a10)", word(5:14) +PRINT "(3f10.3)", a(1)*a(2)+i, SQRT(a(3:4)) +``` + +Variables, but not expressions, are equally valid in input statements +using the `READ` statement: + +``` fortran +READ "(i10)", i +``` + +If an array appears as an item, it is treated as if the elements were +specified in array element order. + +Any pointers in an I/O list must be associated with a target, and +transfer takes place between the file and the targets. + +An item of derived type is treated as if the components were specified +in the same order as in the type declaration, so + +``` fortran +read "(8f10.5)", p, t ! types point and triangle +``` + +has the same effect as the statement + +``` fortran +READ "(8f10.5)", p%x, p%y, t%a%x, t%a%y, t%b%x, & + t%b%y, t%c%x, t%c%y +``` + +An object in an I/O list is not permitted to be of a derived type that +has a pointer component at any level of component selection. + +Note that a zero-sized array may occur as an item in an I/O list. Such +an item corresponds to no actual data transfer. + +The format specification may also be given in the form of a character +expression: + +``` fortran +CHARACTER(len=*), parameter :: form = "(f10.3)" +: +PRINT form, q +``` + +or as an asterisk this is a type of I/O known as *list-directed* I/O +(see +below), +in which the format is defined by the computer system: + +``` fortran +PRINT *, "Square-root of q = ", SQRT(q) +``` + +Input/output operations are used to transfer data between the storage of +an executing program and an external medium, specified by a *unit +number*. However, two I/O statements, `PRINT` and a variant of `READ`, +do not reference any unit number: this is referred to as terminal I/O. +Otherwise the form is: + +``` fortran +READ (UNIT=4, FMT="(f10.3)") q +READ (UNIT=nunit, FMT="(f10.3)") q +READ (UNIT=4*i+j, FMT="(f10.3)") a +``` + +where `UNIT=` is optional. The value may be any nonnegative integer +allowed by the system for this purpose (but 0, 5 and 6 often denote the +error, keyboard and terminal, respectively). + +An asterisk is a variantagain from the keyboard: + +``` fortran +READ (UNIT=*, FMT="(f10.3)") q +``` + +A read with a unit specifier allows +exception handling: + +``` fortran +READ (UNIT=NUNIT, FMT="(3f10.3)", IOSTAT=ios) a,b,c +IF (ios == 0) THEN +! Successful read - continue execution. + : +ELSE +! Error condition - take appropriate action. + CALL error (ios) +END IF +``` + +There a second type of formatted output statement, the `WRITE` +statement: + +``` fortran +WRITE (UNIT=nout, FMT="(10f10.3)", IOSTAT=ios) a +``` + +### Internal files + +These allow format conversion between various representations to be +carried out by the program in a storage area defined within the program +itself. + +``` fortran +INTEGER, DIMENSION(30) :: ival +INTEGER :: key +CHARACTER(LEN=30) :: buffer +CHARACTER(LEN=6), DIMENSION(3), PARAMETER :: form = (/ "(30i1)", "(15i2)","(10i3)" /) +READ (UNIT=*, FMT="(a30,i1)") buffer, key +READ (UNIT=buffer, FMT=form(key)) ival(1:30/key) +``` + +If an internal file is a scalar, it has a single record whose length is +that of the scalar. + +If it is an array, its elements, in array element order, are treated as +successive records of the file and each has length that of an array +element. + +An example using a `WRITE` statement is + +``` fortran +INTEGER :: day +REAL :: cash +CHARACTER(LEN=50) :: line +: +! write into line +WRITE (UNIT=line, FMT="(a, i2, a, f8.2, a)") "Takings for day ", day, " are ", cash, " dollars" +``` + +that might write + + Takings for day 3 are 4329.15 dollars + +### List-directed I/O + +An example of a read without a specified format for input is + +``` fortran +INTEGER :: i +REAL :: a +COMPLEX, DIMENSION(2) :: field +LOGICAL :: flag +CHARACTER(LEN=12) :: title +CHARACTER(LEN=4) :: word +: +READ *, i, a, field, flag, title, word +``` + +If this reads the input record + +``` fortran +10 6.4 (1.0,0.0) (2.0,0.0) t test/ +``` + +(in which blanks are used as separators), then `i`, `a`, `field`, +`flag`, and `title` will acquire the values 10, 6.4, (1.0,0.0) and +(2.0,0.0), `.true.` and `test` respectively, while `word` remains +unchanged. + +Quotation marks or apostrophes are required as delimiters for a string +that contains a blank. + +### Non-advancing I/O + +This is a form of reading and writing without always advancing the file +position to ahead of the next record. Whereas an advancing I/O statement +always repositions the file after the last record accessed, a +non-advancing I/O statement performs no such repositioning and may +therefore leave the file positioned within a record. + +``` fortran +CHARACTER(LEN=3) :: key +INTEGER :: u, s, ios +: +READ(UNIT=u, FMT="(a3)", ADVANCE="no", SIZE=s, IOSTAT=ios) key +IF (ios == 0) THEN + : +ELSE +! key is not in one record + key(s+1:) = "" + : +END IF +``` + +A non-advancing read might read the first few characters of a record and +a normal read the remainder. + +In order to write a prompt to a terminal screen and to read from the +next character position on the screen without an intervening line-feed, +we can write + +``` fortran +WRITE (UNIT=*, FMT="(a)", ADVANCE="no") "enter next prime number:" +READ (UNIT=*, FMT="(i10)") prime_number +``` + +Non-advancing I/O is for external files, and is not available for +list-directed I/O. + +### Edit descriptors + +It is possible to specify that an edit descriptor be repeated a +specified number of times, using a *repeat count*: `10f12.3` + +The slash edit descriptor (see +below) may have a repeat count, and a repeat count can +also apply to a group of edit descriptors, enclosed in parentheses, with +nesting: + +``` fortran +PRINT "(2(2i5,2f8.2))", i(1),i(2),a(1),a(2), i(3),i(4),a(3),a(4) +``` + +Entire format specifications can be repeated: + +``` fortran +PRINT "(10i8)", (/ (i(j), j=1,200) /) +``` + +writes 10 integers, each occupying 8 character positions, on each of 20 +lines (repeating the format specification advances to the next line). + +#### Data edit descriptors + +#### Control edit descriptors + +*Control edit descriptors setting conditions*: *Control edit descriptors +for immediate processing*: + +### Unformatted I/O + +This type of I/O should be used only in cases where the records are +generated by a program on one computer, to be read back on the same +computer or another computer using the same internal number +representations: + +``` fortran +OPEN(UNIT=4, FILE='test', FORM='unformatted') +READ(UNIT=4) q +WRITE(UNIT=nout, IOSTAT=ios) a ! no fmt= +``` + +### Direct-access files + +This form of I/O is also known as random access or indexed I/O. Here, +all the records have the same length, and each record is identified by +an index number. It is possible to write, read, or re-write any +specified record without regard to position. + +``` fortran +INTEGER, PARAMETER :: nunit=2, length=100 +REAL, DIMENSION(length) :: a +REAL, DIMENSION(length+1:2*length) :: b +INTEGER :: i, rec_length +: +INQUIRE (IOLENGTH=rec_length) a +OPEN (UNIT=nunit, ACCESS="direct", RECL=rec_length, STATUS="scratch", ACTION="readwrite") +: +! Write array b to direct-access file in record 14 +WRITE (UNIT=nunit, REC=14) b +: +! +! Read the array back into array a +READ (UNIT=nunit, REC=14) a +: +DO i = 1, length/2 + a(i) = i +END DO +! +! Replace modified record +WRITE (UNIT=nunit, REC=14) a +``` + +The file must be an external file and list-directed formatting and +non-advancing I/O are unavailable. + + +## Operations on external files + +Once again, this is an overview only. + +### File positioning statements + +### The `OPEN` statement + +The statement is used to connect an external file to a unit, create a +file that is preconnected, or create a file and connect it to a unit. +The syntax is + +``` fortran +OPEN (UNIT=u, STATUS=st, ACTION=act [,olist]) +``` + +where `olist` is a list of optional specifiers. The specifiers may +appear in any order. + +``` fortran +OPEN (UNIT=2, IOSTAT=ios, FILE="cities", STATUS="new", ACCESS="direct", & + ACTION="readwrite", RECL=100) +``` + +Other specifiers are `FORM` and `POSITION`. + +### The `CLOSE` statement + +This is used to disconnect a file from a unit. + +``` fortran +CLOSE (UNIT=u [, IOSTAT=ios] [, STATUS=st]) +``` + +as in + +``` fortran +CLOSE (UNIT=2, IOSTAT=ios, STATUS="delete") +``` + +### The `inquire` statement + +At any time during the execution of a program it is possible to inquire +about the status and attributes of a file using this statement. + +Using a variant of this statement, it is similarly possible to determine +the status of a unit, for instance whether the unit number exists for +that system. + +Another variant permits an inquiry about the length of an output list +when used to write an unformatted record. + +For inquire by unit + +``` fortran +INQUIRE (UNIT=u, ilist) +``` + +or for inquire by file + +``` fortran +INQUIRE (FILE=fln, ilist) +``` + +or for inquire by I/O list + +``` fortran +INQUIRE (IOLENGTH=length) olist +``` + +As an example + +``` fortran +LOGICAL :: ex, op +CHARACTER (LEN=11) :: nam, acc, seq, frm +INTEGER :: irec, nr +INQUIRE (UNIT=2, EXIST=ex, OPENED=op, NAME=nam, ACCESS=acc, SEQUENTIAL=seq, & + FORM=frm, RECL=irec, NEXTREC=nr) +``` + +yields + +``` fortran +ex .true. +op .true. +nam cities +acc DIRECT +seq NO +frm UNFORMATTED +irec 100 +nr 1 +``` + +(assuming no intervening read or write operations). + +Other specifiers are +`IOSTAT, OPENED, NUMBER, NAMED, FORMATTED, POSITION, ACTION, READ, WRITE, READWRITE`. + +```mediawiki +==References== +{{Reflist}} +=== Bibliography === +{{refbegin}} +* {{Citation |last=Metcalf |first=Michael |title=Whence Fortran? |date=2004-06-17 |work=Fortran 95/2003 Explained |pages=1–8 |url=https://doi.org/10.1093/oso/9780198526926.003.0001 |access-date=2025-02-25 |publisher=Oxford University PressOxford |isbn=978-0-19-852692-6 |last2=Reid |first2=John |last3=Cohen |first3=Malcolm}} +* {{Citation |title=Introduction to Modern Fortran |work=Statistics and Computing |pages=13–53 |url=https://doi.org/10.1007/0-387-28123-1_2 |access-date=2025-02-25 |place=New York |publisher=Springer-Verlag |isbn=0-387-23817-4}} +* {{Cite journal |last=Gehrke |first=Wilhelm |date=1996 |title=Fortran 95 Language Guide |url=https://doi.org/10.1007/978-1-4471-1025-5 |doi=10.1007/978-1-4471-1025-5}} +* {{Citation |last=Chivers |first=Ian |title=Fortran 2000 and Various Fortran Dialects |date=2000 |work=Introducing Fortran 95 |pages=377–388 |url=https://doi.org/10.1007/978-1-4471-0403-2_29 |access-date=2025-02-25 |place=London |publisher=Springer London |isbn=978-1-85233-276-1 |last2=Sleightholme |first2=Jane}} +* {{cite book|title=Fortran 95|author1-first=Martin|author1-last=Counihan|edition=2nd|publisher=CRC Press|year=2006|isbn=9780203978467}} +* {{cite book|title=Computer programming in FORTRAN 90 and 95|author1-first=V.|author1-last=Ramaraman|publisher=PHI Learning Pvt. Ltd.|year=1997|isbn=9788120311817}} +* {{cite book|title=Modern Fortran Explained: Incorporating Fortran 2023|author1-first=Michael|author1-last=Metcalf|author2-first=John|author2-last=Reid|author3-first=Malcolm|author3-last=Cohen|author4-first=Reinhold|author4-last=Bader|edition=6th|publisher=Oxford University Press|year=2024|isbn=9780198876595}} +* {{cite book|title=An Introduction to Fortran 90/95: Syntax and Programming|author1-first=Yogendra Prasad|author1-last=Joshi|publisher=Allied Publishers|isbn=9788177644746}} +{{refend}} +{{Authority control}} + +{{DEFAULTSORT:Fortran Language Features}} +[[Category:Fortran|Features]] +``` From da69a39967fb2b14525a8dd62de149304eb8bcf4 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sun, 2 Mar 2025 19:35:07 +0100 Subject: [PATCH 03/10] add reference to "root version" of the booklet Added an explicit note about the last commit (on side of Wikipedia) the source of this booklet is about. Signed-off-by: Norwid Behrnd --- source/learn/f95_features/f95_features.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md index fc235da695fb..89af5e12373c 100644 --- a/source/learn/f95_features/f95_features.md +++ b/source/learn/f95_features/f95_features.md @@ -18,6 +18,11 @@ in the sections below can be found in the standards documents,[^iso_1539_2023] textbooks[^OOPvF][^OOPC][^Chapman] as well as the **Bibliography**. +The booklet is based on Wikipedia's article +[Fortran 95 language +features](https://en.wikipedia.org/wiki/Fortran_95_language_features), +last edit by February 25, 2025 16:08 UTC. + [^iso_1539_1997]: [ISO/IEC 1539-1:1997](https://www.iso.org/standard/26933.html) [^iso_1539_2023]: [ISO/IEC 1539-1:2023](https://www.iso.org/standard/82170.html) From aa29e6de78a224a7ae998444069c765e27ab5dda Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sun, 2 Mar 2025 19:47:45 +0100 Subject: [PATCH 04/10] adjust code fences to f90 Throughout the source file (and equally in the mediawiki file), the label of the code fences was `fortran`. Because the file is about Fortran 95, it was updated by ```bash sed 's/``` fortran/```f90/' f95_features.md > temp.txt mv temp.text f95_features.md rm temp.txt ``` Signed-off-by: Norwid Behrnd --- source/learn/f95_features/f95_features.md | 478 +++++++++++----------- 1 file changed, 239 insertions(+), 239 deletions(-) diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md index 89af5e12373c..b63ac4093378 100644 --- a/source/learn/f95_features/f95_features.md +++ b/source/learn/f95_features/f95_features.md @@ -85,7 +85,7 @@ title="statement">statements are built. These can be coded using the new free *source form* which does not require positioning in a rigid column structure: -``` fortran +```f90 FUNCTION string_concat(s1, s2) ! This is a comment TYPE (string), INTENT(IN) :: s1, s2 TYPE (string) string_concat @@ -100,7 +100,7 @@ be 39 continuation lines, and 132 characters per line. Blanks are significant. Where a token or character constant is split across two lines: -``` fortran +```f90 ... start_of& &_name ... 'a very long & @@ -132,7 +132,7 @@ and `REAL` can only be signed (there is no concept of sign for type Integer literal constants of the default kind take the form -``` fortran +```f90 1 0 -999 32767 +10 ``` @@ -140,20 +140,20 @@ Kind can be defined as a named constant. If the desired range is ±10kind, the portable syntax for defining the appropriate kind, `two_bytes` is -``` fortran +```f90 INTEGER, PARAMETER :: two_bytes = SELECTED_INT_KIND(4) ``` that allows subsequent definition of constants of the form -``` fortran +```f90 -1234_two_bytes +1_two_bytes ``` Here, `two_bytes` is the kind type parameter; it can also be an explicit default integer literal constant, like -``` fortran +```f90 -1234_2 ``` @@ -161,14 +161,14 @@ but such use is non-portable. The KIND function supplies the value of a kind type parameter: -``` fortran +```f90 KIND(1) KIND(1_two_bytes) ``` and the `RANGE` function supplies the actual decimal range (so the user must make the actual mapping to bytes): -``` fortran +```f90 RANGE(1_two_bytes) ``` @@ -178,7 +178,7 @@ title="DATA (initialization) statements">DATA (Z) constants may be used (often informally referred to as "BOZ constants"): -``` fortran +```f90 B'01010101' O'01234567' Z'10fa' ``` @@ -187,13 +187,13 @@ B'01010101' O'01234567' Z'10fa' There are at least two real kindsthe default and one with greater precision (this replaces -``` fortran +```f90 DOUBLE PRECISION ``` ). -``` fortran +```f90 SELECTED_REAL_KIND ``` @@ -201,19 +201,19 @@ functions returns the kind number for desired range and precision; for at least 9 decimal digits of precision and a range of 10−99 to 1099, it can be specified as: -``` fortran +```f90 INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(9, 99) ``` and literals subsequently specified as -``` fortran +```f90 1.7_long ``` Also, there are the intrinsic functions -``` fortran +```f90 KIND(1.7_long) PRECISION(1.7_long) RANGE(1.7_long) ``` @@ -224,7 +224,7 @@ least 9), and the actual range (here at least 99). `COMPLEX` data type is built of two integer or real components: -``` fortran +```f90 (1, 3.7_long) ``` @@ -235,13 +235,13 @@ There are only two basic values of logical constants: `.TRUE.` and their own kind inquiry functions, but use the kinds specified for `INTEGER`s; default kind of `LOGICAL` is the same as of INTEGER. -``` fortran +```f90 .FALSE. .true._one_byte ``` and the `KIND` function operates as expected: -``` fortran +```f90 KIND(.TRUE.) ``` @@ -249,7 +249,7 @@ KIND(.TRUE.) The forms of literal constants for `CHARACTER` data type are -``` fortran +```f90 'A string' "Another" 'A "quote"' ''''''' ``` @@ -260,7 +260,7 @@ example, to distinguish but not widely supported by compilers. Again, the kind value is given by the `KIND` function: -``` fortran +```f90 KIND('ASCII') ``` @@ -289,7 +289,7 @@ Scalar variables corresponding to the five intrinsic types are specified as follows: -``` fortran +```f90 INTEGER(KIND=2) :: i REAL(KIND=long) :: a COMPLEX :: current @@ -307,7 +307,7 @@ While it is not required in above examples (as there are no additional attributes and initialization), most Fortran-90 programmers acquire the habit to use it everywhere. -``` fortran +```f90 LEN= ``` @@ -315,7 +315,7 @@ specifier is applicable only to `CHARACTER`s and specifies the string length (replacing the older `*len` form). The explicit `KIND=` and `LEN=` specifiers are optional: -``` fortran +```f90 CHARACTER(2, Kanji) :: kanji_word ``` @@ -324,20 +324,20 @@ works just as well. There are some other interesting character features. Just as a substring as in -``` fortran +```f90 CHARACTER(80) :: line ... = line(i:i) ! substring ``` was previously possible, so now is the substring -``` fortran +```f90 '0123456789'(i:i) ``` Also, zero-length strings are allowed: -``` fortran +```f90 line(i:i-1) ! zero-length string ``` @@ -355,7 +355,7 @@ Finally, there is a set of intrinsic character functions, examples being For derived data types, the form of the type must be defined first: -``` fortran +```f90 TYPE person CHARACTER(10) name REAL age @@ -364,27 +364,27 @@ END TYPE person and then, variables of that type can be defined: -``` fortran +```f90 TYPE(person) you, me ``` To select components of a derived type, `%` qualifier is used: -``` fortran +```f90 you%age ``` Literal constants of derived types have the form *`TypeName(1stComponentLiteral, 2ndComponentLiteral, ...)`*: -``` fortran +```f90 you = person('Smith', 23.5) ``` which is known as a *structure constructor*. Definitions may refer to a previously defined type: -``` fortran +```f90 TYPE point REAL x, y END TYPE point @@ -395,19 +395,19 @@ END TYPE triangle and for a variable of type triangle, as in -``` fortran +```f90 TYPE(triangle) t ``` each component of type `point` is accessed as -``` fortran +```f90 t%a t%b t%c ``` which, in turn, have ultimate components of type real: -``` fortran +```f90 t%a%x t%a%y t%b%x etc. ``` @@ -422,7 +422,7 @@ other data types must be explicitly declared. This is known as *implicit typing* and is a heritage of early FORTRAN days. Those defaults can be overridden by *`IMPLICIT TypeName (CharacterRange)`* statements, like: -``` fortran +```f90 IMPLICIT COMPLEX(Z) IMPLICIT CHARACTER(A-B) IMPLICIT REAL(C-H,N-Y) @@ -431,7 +431,7 @@ IMPLICIT REAL(C-H,N-Y) However, it is a good practice to explicitly type all variables, and this can be forced by inserting the statement -``` fortran +```f90 IMPLICIT NONE ``` @@ -450,7 +450,7 @@ arbitrary bounds can be explicitly specified. `DIMENSION` keyword is optional and considered an attribute; if omitted, the array shape must be specified after array-variable name. For example, -``` fortran +```f90 REAL:: a(10) INTEGER, DIMENSION(0:100, -50:50) :: map ``` @@ -460,7 +460,7 @@ declares two arrays, rank-1 and rank-2, whose elements are in title="column-major order">column-major order. Elements are, for example, -``` fortran +```f90 a(1) a(i*j) ``` @@ -468,7 +468,7 @@ and are scalars. The subscripts may be any scalar integer expression. *Sections* are parts of the array variables, and are arrays themselves: -``` fortran +```f90 a(i:j) ! rank one map(i:j, k:l:m) ! rank two a(map(i, k:l)) ! vector subscript @@ -478,7 +478,7 @@ a(3:2) ! zero length Whole arrays and array sections are array-valued objects. Array-valued constants (constructors) are available, enclosed in `(/ ... /)`: -``` fortran +```f90 (/ 1, 2, 3, 4 /) (/ ( (/ 1, 2, 3 /), i = 1, 4) /) (/ (i, i = 1, 9, 2) /) @@ -491,7 +491,7 @@ of brackets: `[1, 2, 3, 4]` and `[([1,2,3], i=1,4)]` instead of the first two examples above, and many compilers support this now. A derived data type may, of course, contain array components: -``` fortran +```f90 TYPE triplet REAL, DIMENSION(3) :: vertex END TYPE triplet @@ -500,13 +500,13 @@ TYPE(triplet), DIMENSION(4) :: t so that -- ``` fortran +- ```f90 t(2) ``` is a scalar (a structure) -- ``` fortran +- ```f90 t(2)%vertex ``` @@ -517,14 +517,14 @@ so that Variables can be given initial values as specified in a specification statement: -``` fortran +```f90 REAL, DIMENSION(3) :: a = (/ 0.1, 0.2, 0.3 /) ``` and a default initial value can be given to the component of a derived data type: -``` fortran +```f90 TYPE triplet REAL, DIMENSION(3) :: vertex = 0.0 END TYPE triplet @@ -533,13 +533,13 @@ END TYPE triplet When local variables are initialized within a procedure they implicitly acquire the SAVE attribute: -``` fortran +```f90 REAL, DIMENSION(3) :: point = (/ 0.0, 1.0, -1.0 /) ``` This declaration is equivalent to -``` fortran +```f90 REAL, DIMENSION(3), SAVE :: point = (/ 0.0, 1.0, -1.0 /) ``` @@ -553,7 +553,7 @@ procedure. A named constant can be specified directly by adding the `PARAMETER` attribute and the constant values to a type statement: -``` fortran +```f90 REAL, DIMENSION(3), PARAMETER :: field = (/ 0., 1., 2. /) TYPE(triplet), PARAMETER :: t = triplet( (/ 0., 0., 0. /) ) ``` @@ -565,7 +565,7 @@ variables of derived type. It is also the only way to initialise just parts of such objects, as well as to initialise to binary, octal or hexadecimal values: -``` fortran +```f90 TYPE(triplet) :: t1, t2 DATA t1/triplet( (/ 0., 1., 2. /) )/, t2%vertex(1)/123./ DATA array(1:64) / 64*0/ @@ -582,7 +582,7 @@ functions `REPEAT, SELECTED_INT_KIND, TRIM, SELECTED_REAL_KIND, RESHAPE` and `TRANSFER` (see Intrinsic procedures): -``` fortran +```f90 INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(12), & array(3) = (/ 1, 2, 3 /) ``` @@ -593,7 +593,7 @@ It is possible to specify details of variables using any non-constant, scalar, integer expression that may also include inquiry function references: -``` fortran +```f90 SUBROUTINE s(b, m, c) USE mod ! contains a REAL, DIMENSION(:, :) :: b @@ -614,7 +614,7 @@ here in increasing order of precedence). Parentheses are used to indicate the order of evaluation where necessary: -``` fortran +```f90 a*b + c ! * first a*(b + c) ! + first ``` @@ -624,7 +624,7 @@ the non-default kinds. Thus, the mixed-mode numeric expression and assignment rules incorporate different kind type parameters in an expected way: -``` fortran +```f90 real2 = integer0 + real1 ``` @@ -656,7 +656,7 @@ built-in operators: (the forms above are new to Fortran-90, and older equivalent forms are given below them). Example expressions: -``` fortran +```f90 a < b .AND. i /= j ! for numeric variables flag = a == b ! for logical variable flags ``` @@ -665,20 +665,20 @@ flag = a == b ! for logical variable flags In the case of *scalar characters* and given -``` fortran +```f90 CHARACTER(8) result ``` it is legal to write -``` fortran +```f90 result(3:5) = result(1:3) ! overlap allowed result(3:3) = result(3:2) ! no assignment of null string ``` Concatenation is performed by the operator '//'. -``` fortran +```f90 result = 'abcde'//'123' filename = result//'.dat' ``` @@ -690,7 +690,7 @@ component basis) exist between *derived data types* mutually or with intrinsic types. The meaning of existing or user-specified operators can be (re)defined though: -``` fortran +```f90 TYPE string80 INTEGER length CHARACTER(80) value @@ -701,7 +701,7 @@ TYPE(string80):: str1, str2, str3 we can write -``` fortran +```f90 str3 = str1//str2 ! must define operation str3 = str1.concat.str2 ! must define operation char3 = char2//char3 ! intrinsic operator only @@ -715,7 +715,7 @@ that, for an intrinsic operator token, the usual precedence rules apply, whereas for named operators, precedence is the highest as a unary operator or the lowest as a binary one. In -``` fortran +```f90 vector3 = matrix * vector1 + vector2 vector3 =(matrix .times. vector1) + vector2 ``` @@ -726,7 +726,7 @@ added as shown. In each case there must be defined, in a procedures defining the operator and assignment, and corresponding operator-procedure association, as follows: -``` fortran +```f90 INTERFACE OPERATOR(//) !Overloads the // operator as invoking string_concat procedure MODULE PROCEDURE string_concat END INTERFACE @@ -740,7 +740,7 @@ together exceed the preset 80-character limit, it would be safer to use a subroutine to perform the concatenation (in this case operator-overloading would not be applicable.) -``` fortran +```f90 MODULE string_type IMPLICIT NONE TYPE string80 @@ -799,7 +799,7 @@ are allowed also in structure constructors (see Derived-data types): -``` fortran +```f90 str1 = string(2, char1//char2) ! structure constructor ``` @@ -809,7 +809,7 @@ In the case of arrays then, as long as they are of the same shape (conformable), operations and assignments are extended in an obvious way, on an element-by-element basis. For example, given declarations of -``` fortran +```f90 REAL, DIMENSION(10, 20) :: a, b, c REAL, DIMENSION(5) :: v, w LOGICAL flag(10, 20) @@ -817,7 +817,7 @@ LOGICAL flag(10, 20) it can be written: -``` fortran +```f90 a = b ! whole array assignment c = a/b ! whole array division and assignment c = 0. ! whole array assignment of scalar value @@ -835,45 +835,45 @@ operators for arrays of derived type must be defined. Some real intrinsic functions that are useful for numeric computations are -- ``` fortran +- ```f90 CEILING ``` -- ``` fortran +- ```f90 FLOOR ``` -- ``` fortran +- ```f90 MODULO ``` (also integer) -- ``` fortran +- ```f90 EXPONENT ``` -- ``` fortran +- ```f90 FRACTION ``` -- ``` fortran +- ```f90 NEAREST ``` -- ``` fortran +- ```f90 RRSPACING ``` -- ``` fortran +- ```f90 SPACING ``` -- ``` fortran +- ```f90 SCALE ``` -- ``` fortran +- ```f90 SET_EXPONENT ``` @@ -881,149 +881,149 @@ These are array valued for array arguments (elemental), like all FORTRAN 77 functions (except LEN): -- ``` fortran +- ```f90 INT ``` -- ``` fortran +- ```f90 REAL ``` -- ``` fortran +- ```f90 CMPLX ``` -- ``` fortran +- ```f90 AINT ``` -- ``` fortran +- ```f90 ANINT ``` -- ``` fortran +- ```f90 NINT ``` -- ``` fortran +- ```f90 ABS ``` -- ``` fortran +- ```f90 MOD ``` -- ``` fortran +- ```f90 SIGN ``` -- ``` fortran +- ```f90 DIM ``` -- ``` fortran +- ```f90 MAX ``` -- ``` fortran +- ```f90 MIN ``` Powers, logarithms, and trigonometric functions -- ``` fortran +- ```f90 SQRT ``` -- ``` fortran +- ```f90 EXP ``` -- ``` fortran +- ```f90 LOG ``` -- ``` fortran +- ```f90 LOG10 ``` -- ``` fortran +- ```f90 SIN ``` -- ``` fortran +- ```f90 COS ``` -- ``` fortran +- ```f90 TAN ``` -- ``` fortran +- ```f90 ASIN ``` -- ``` fortran +- ```f90 ACOS ``` -- ``` fortran +- ```f90 ATAN ``` -- ``` fortran +- ```f90 ATAN2 ``` -- ``` fortran +- ```f90 SINH ``` -- ``` fortran +- ```f90 COSH ``` -- ``` fortran +- ```f90 TANH ``` Complex numbers: -- ``` fortran +- ```f90 AIMAG ``` -- ``` fortran +- ```f90 CONJG ``` The following are for characters: -- ``` fortran +- ```f90 LGE ``` -- ``` fortran +- ```f90 LGT ``` -- ``` fortran +- ```f90 LLE ``` -- ``` fortran +- ```f90 LLT ``` -- ``` fortran +- ```f90 ICHAR ``` -- ``` fortran +- ```f90 CHAR ``` -- ``` fortran +- ```f90 INDEX ``` @@ -1037,13 +1037,13 @@ more clarity. The simple conditional test is the `IF` statement: -``` fortran +```f90 IF (a > b) x = y ``` A full-blown `IF` construct is illustrated by -``` fortran +```f90 IF (i < 0) THEN IF (j < 0) THEN x = 0. @@ -1062,7 +1062,7 @@ END IF The `CASE` construct is a replacement for the computed `GOTO`, but is better structured and does not require the use of statement labels: -``` fortran +```f90 SELECT CASE (number) ! number of type integer CASE (:-1) ! all values below 0 n_sign = -1 @@ -1077,13 +1077,13 @@ Each `CASE` selector list may contain a list and/or range of integers, character or logical constants, whose values may not overlap within or between selectors: -``` fortran +```f90 CASE (1, 2, 7, 10:17, 23) ``` A default is available: -``` fortran +```f90 CASE DEFAULT ``` @@ -1093,7 +1093,7 @@ There is only one evaluation, and only one match. A simplified but sufficient form of the `DO` construct is illustrated by -``` fortran +```f90 outer: DO inner: DO i = j, k, l ! from j to k in steps of l (l is optional) : @@ -1111,7 +1111,7 @@ CYCLE statement may specify which loop is meant. Many, but not all, simple loops can be replaced by array expressions and assignments, or by new intrinsic functions. For instance -``` fortran +```f90 tot = 0. DO i = m, n tot = tot + a(i) @@ -1120,7 +1120,7 @@ END DO becomes simply -``` fortran +```f90 tot = SUM( a(m:n) ) ``` @@ -1141,7 +1141,7 @@ subprograms* or *modules* and can be separately compiled. An example of a main (and complete) program is -``` fortran +```f90 PROGRAM test PRINT *, 'Hello world!' END PROGRAM test @@ -1150,7 +1150,7 @@ END PROGRAM test An example of a main program and an external subprogram, forming an executable program, is -``` fortran +```f90 PROGRAM test CALL print_message END PROGRAM test @@ -1161,7 +1161,7 @@ END SUBROUTINE print_message The form of a function is -``` fortran +```f90 FUNCTION name(arg1, arg2) ! zero or more arguments : name = ... @@ -1171,7 +1171,7 @@ END FUNCTION name The form of reference of a function is -``` fortran +```f90 x = name(a, b) ``` @@ -1181,7 +1181,7 @@ An internal subprogram is one *contained* in another (at a maximum of one level of nesting) and provides a replacement for the statement function: -``` fortran +```f90 SUBROUTINE outer REAL x, y : @@ -1221,7 +1221,7 @@ Modules are used to package An example of a module containing a type definition, interface block and function subprogram is -``` fortran +```f90 MODULE interval_arithmetic TYPE interval REAL lower, upper @@ -1243,7 +1243,7 @@ END MODULE interval_arithmetic and the simple statement -``` fortran +```f90 USE interval_arithmetic ``` @@ -1256,14 +1256,14 @@ subprograms may, in turn, contain internal subprograms. The `PUBLIC` and `PRIVATE` attributes are used in specifications in modules to limit the scope of entities. The attribute form is -``` fortran +```f90 REAL, PUBLIC :: x, y, z ! default INTEGER, PRIVATE :: u, v, w ``` and the statement form is -``` fortran +```f90 PUBLIC :: x, y, z, OPERATOR(.add.) PRIVATE :: u, v, w, ASSIGNMENT(=), OPERATOR(*) ``` @@ -1271,7 +1271,7 @@ PRIVATE :: u, v, w, ASSIGNMENT(=), OPERATOR(*) The statement form has to be used to limit access to operators, and can also be used to change the overall default: -``` fortran +```f90 PRIVATE ! sets default for module PUBLIC :: only_this ``` @@ -1281,7 +1281,7 @@ components are all PUBLIC, the type is PUBLIC and its components PRIVATE (the type only is visible and one can change its details easily), or all of it is PRIVATE (for internal use in the module only): -``` fortran +```f90 MODULE mine PRIVATE TYPE, PUBLIC :: list @@ -1297,19 +1297,19 @@ The `USE` statement's purpose is to gain access to entities in a module. It has options to resolve name clashes if an imported name is the same as a local one: -``` fortran +```f90 USE mine, local_list => list ``` or to restrict the used entities to a specified set: -``` fortran +```f90 USE mine, ONLY : list ``` These may be combined: -``` fortran +```f90 USE mine, ONLY : local_list => list ``` @@ -1317,7 +1317,7 @@ USE mine, ONLY : local_list => list We may specify the intent of dummy arguments: -``` fortran +```f90 SUBROUTINE shuffle (ncards, cards) INTEGER, INTENT(IN) :: ncards INTEGER, INTENT(OUT), DIMENSION(ncards) :: cards @@ -1328,7 +1328,7 @@ Also, INOUT is possible: here the actual argument must be a variable Arguments may be optional: -``` fortran +```f90 SUBROUTINE mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstart) REAL, OPTIONAL, DIMENSION :: upper, lower : @@ -1338,13 +1338,13 @@ SUBROUTINE mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstar allows us to call `mincon` by -``` fortran +```f90 CALL mincon (n, f, x, upper) ``` Arguments may be keyword rather than positional (which come first): -``` fortran +```f90 CALL mincon(n, f, x, equalities=0, xstart=x0) ``` @@ -1361,7 +1361,7 @@ an explicit interface in this case too. It is a copy of the header, specifications and END statement of the procedure concerned, either placed in a module or inserted directly: -``` fortran +```f90 REAL FUNCTION minimum(a, b, func) ! returns the minimum value of the function func(x) ! in the interval (a,b) @@ -1400,7 +1400,7 @@ use it as an internal procedure.** Interface blocks provide the mechanism by which we are able to define generic names for specific procedures: -``` fortran +```f90 INTERFACE gamma ! generic name FUNCTION sgamma(X) ! specific name REAL (SELECTED_REAL_KIND( 6)) sgamma, x @@ -1415,7 +1415,7 @@ where a given set of specific names corresponding to a generic name must all be of functions or all of subroutines. If this interface is within a module, then it is simply -``` fortran +```f90 INTERFACE gamma MODULE PROCEDURE sgamma, dgamma END INTERFACE @@ -1432,13 +1432,13 @@ and assignment (see Indirect recursion is useful for multi-dimensional integration. For -``` fortran +```f90 volume = integrate(fy, ybounds) ``` We might have -``` fortran +```f90 RECURSIVE FUNCTION integrate(f, bounds) ! Integrate f(x) from bounds(1) to bounds(2) REAL integrate @@ -1454,7 +1454,7 @@ END FUNCTION integrate and to integrate *f(x, y)* over a rectangle: -``` fortran +```f90 FUNCTION fy(y) USE func ! module func contains function f REAL fy, y @@ -1465,7 +1465,7 @@ END Direct recursion is when a procedure calls itself, as in -``` fortran +```f90 RECURSIVE FUNCTION factorial(n) RESULT(res) INTEGER res, n IF(n.EQ.0) THEN @@ -1498,7 +1498,7 @@ procedure (expressed simply): A compiler can check that this is the case, as in -``` fortran +```f90 PURE FUNCTION calculate (x) ``` @@ -1526,7 +1526,7 @@ now we develop the theme. A zero-sized array is handled by Fortran as a legitimate object, without special coding by the programmer. Thus, in -``` fortran +```f90 DO i = 1,n x(i) = b(i) / a(i, i) b(i+1:n) = b(i+1:n) - a(i+1:n, i) * x(i) @@ -1537,7 +1537,7 @@ no special code is required for the final iteration where `i = n`. We note that a zero-sized array is regarded as being defined; however, an array of shape (0,2) is not conformable with one of shape (0,3), whereas -``` fortran +```f90 x(1:0) = 3 ``` @@ -1548,7 +1548,7 @@ is a valid 'do nothing' statement. These are an extension and replacement for assumed-size arrays. Given an actual argument like: -``` fortran +```f90 REAL, DIMENSION(0:10, 0:20) :: a : CALL sub(a) @@ -1560,7 +1560,7 @@ available by an explicit interface, often using an interface block (see Interface blocks). Thus we write just -``` fortran +```f90 SUBROUTINE sub(da) REAL, DIMENSION(:, :) :: da ``` @@ -1568,7 +1568,7 @@ SUBROUTINE sub(da) and this is as if `da` were dimensioned (11,21). However, we can specify any lower bound and the array maps accordingly. -``` fortran +```f90 REAL, DIMENSION(0:, 0:) :: da ``` @@ -1580,7 +1580,7 @@ the default upper bound is the corresponding extent. A partial replacement for the uses to which `EQUIVALENCE` was put is provided by this facility, useful for local, temporary arrays, as in -``` fortran +```f90 SUBROUTINE swap(a, b) REAL, DIMENSION(:) :: a, b REAL, DIMENSION(SIZE(a)) :: work @@ -1598,7 +1598,7 @@ Fortran provides dynamic allocation of storage; it relies on a heap storage mechanism (and replaces another use of `EQUIVALENCE`). An example for establishing a work array for a whole program is -``` fortran +```f90 MODULE work_array INTEGER n REAL, DIMENSION(:,:,:), ALLOCATABLE :: work @@ -1616,7 +1616,7 @@ statement in each program unit. We may specify an explicit lower bound and allocate several entities in one statement. To free dead storage we write, for instance, -``` fortran +```f90 DEALLOCATE(a, b) ``` @@ -1626,7 +1626,7 @@ Deallocation of arrays is automatic when they go out of scope. We have already met whole array assignments and operations: -``` fortran +```f90 REAL, DIMENSION(10) :: a, b a = 0. ! scalar broadcast; elemental assignment b = SQRT(a) ! intrinsic function result as array object @@ -1636,7 +1636,7 @@ In the second assignment, an intrinsic function returns an array-valued result for an array-valued argument. We can write array-valued functions ourselves (they require an explicit interface): -``` fortran +```f90 PROGRAM test REAL, DIMENSION(3) :: a = (/ 1., 2., 3./), & b = (/ 2., 2., 2. /), r @@ -1661,7 +1661,7 @@ writing, in Fortran 90, 22 different versions, for ranks 0-0, 0-1, 1-0, 1-1, 0-2, 2-0, 2-2, ... 7-7, and is further an aid to optimization on parallel processors. An elemental procedure must be pure. -``` fortran +```f90 ELEMENTAL SUBROUTINE swap(a, b) REAL, INTENT(INOUT) :: a, b REAL :: work @@ -1682,14 +1682,14 @@ functions (`BIT_SIZE`, `KIND`, `LEN`, and the numeric inquiry ones, (see Often, we need to mask an assignment. This we can do using the `WHERE`, either as a statement: -``` fortran +```f90 WHERE (a /= 0.0) a = 1.0/a ! avoid division by 0 ``` (note: the test is element-by-element, not on whole array), or as a construct: -``` fortran +```f90 WHERE (a /= 0.0) a = 1.0/a b = a ! all arrays same shape @@ -1698,7 +1698,7 @@ END WHERE or -``` fortran +```f90 WHERE (a /= 0.0) a = 1.0/a ELSEWHERE @@ -1727,7 +1727,7 @@ When a `DO` construct is executed, each successive iteration is performed in order and one after the otheran impediment to optimization on a parallel processor. -``` fortran +```f90 FORALL(i = 1:n) a(i, i) = x(i) ``` @@ -1735,7 +1735,7 @@ where the individual assignments may be carried out in any order, and even simultaneously. The `FORALL` may be considered to be an array assignment expressed with the help of indices. -``` fortran +```f90 FORALL(i=1:n, j=1:n, y(i,j)/=0.) x(j,i) = 1.0/y(i,j) ``` @@ -1744,14 +1744,14 @@ with masking condition. The `FORALL` construct allows several assignment statements to be executed in order. -``` fortran +```f90 a(2:n-1,2:n-1) = a(2:n-1,1:n-2) + a(2:n-1,3:n) + a(1:n-2,2:n-1) + a(3:n,2:n-1) b(2:n-1,2:n-1) = a(2:n-1,2:n-1) ``` is equivalent to the array assignments -``` fortran +```f90 FORALL(i = 2:n-1, j = 2:n-1) a(i,j) = a(i,j-1) + a(i,j+1) + a(i-1,j) + a(i+1,j) b(i,j) = a(i,j) @@ -1772,14 +1772,14 @@ referenced within a `FORALL` must be pure. For a simple case, given -``` fortran +```f90 REAL, DIMENSION(100, 100) :: a ``` we can reference a single element as, for instance, `a(1, 1)`. For a derived-data type like -``` fortran +```f90 TYPE fun_del REAL u REAL, DIMENSION(3) :: du @@ -1788,25 +1788,25 @@ END TYPE fun_del we can declare an array of that type: -``` fortran +```f90 TYPE(fun_del), DIMENSION(10, 20) :: tar ``` and a reference like -``` fortran +```f90 tar(n, 2) ``` is an element (a scalar!) of type fun_del, but -``` fortran +```f90 tar(n, 2)%du ``` is an array of type real, and -``` fortran +```f90 tar(n, 2)%du(2) ``` @@ -1821,7 +1821,7 @@ The general form of subscript for an array section is (where \[ \] indicates an optional item) as in -``` fortran +```f90 REAL a(10, 10) a(i, 1:n) ! part of one row a(1:m, j) ! part of one column @@ -1836,7 +1836,7 @@ a(:, 1:7) ! rank two section Note that a vector subscript with duplicate values cannot appear on the left-hand side of an assignment as it would be ambiguous. Thus, -``` fortran +```f90 b( (/ 1, 7, 3, 7 /) ) = (/ 1, 2, 3, 4 /) ``` @@ -1844,14 +1844,14 @@ is illegal. Also, a section with a vector subscript must not be supplied as an actual argument to an `OUT` or `INOUT` dummy argument. Arrays of arrays are not allowed: -``` fortran +```f90 tar%du ! illegal ``` We note that a given value in an array can be referenced both as an element and as a section: -``` fortran +```f90 a(1, 1) ! scalar (rank zero) a(1:1, 1) ! array section (rank one) ``` @@ -1860,7 +1860,7 @@ depending on the circumstances or requirements. By qualifying objects of derived type, we obtain elements or sections depending on the rule stated earlier: -``` fortran +```f90 tar%u ! array section (structure component) tar(1, 1)%u ! component of an array element ``` @@ -1934,7 +1934,7 @@ tar(1, 1)%u ! component of an array element Pointers are variables with the `POINTER` attribute; they are not a distinct data type (and so no 'pointer arithmetic' is possible). -``` fortran +```f90 REAL, POINTER :: var ``` @@ -1945,21 +1945,21 @@ otherwise associated (by pointer assignment, see below): -``` fortran +```f90 ALLOCATE (var) ``` and they are dereferenced automatically, so no special symbol required. In -``` fortran +```f90 var = var + 2.3 ``` the value of the target of var is used and modified. Pointers cannot be transferred via I/O. The statement -``` fortran +```f90 WRITE *, var ``` @@ -1969,7 +1969,7 @@ itself. A pointer can point to another pointer, and hence to its target, or to a static object that has the `TARGET` attribute: -``` fortran +```f90 REAL, POINTER :: object REAL, TARGET :: target_obj var => object ! pointer assignment @@ -1978,7 +1978,7 @@ var => target_obj but they are strongly typed: -``` fortran +```f90 INTEGER, POINTER :: int_var var => int_var ! illegal - types must match ``` @@ -1987,7 +1987,7 @@ and, similarly, for arrays the ranks as well as the type must agree. A pointer can be a component of a derived type: -``` fortran +```f90 TYPE entry ! type for sparse matrix REAL :: value INTEGER :: index @@ -1997,14 +1997,14 @@ END TYPE entry and we can define the beginning of a linked chain of such entries: -``` fortran +```f90 TYPE(entry), POINTER :: chain ``` After suitable allocations and definitions, the first two entries could be addressed as -``` fortran +```f90 chain%value chain%next%value chain%index chain%next%index chain%next chain%next%next @@ -2022,21 +2022,21 @@ without nullifying any other pointer referring to it. The intrinsic function `ASSOCIATED` can test the association status of a defined pointer: -``` fortran +```f90 IF (ASSOCIATED(ptr)) THEN ``` or between a defined pointer and a defined target (which may, itself, be a pointer): -``` fortran +```f90 IF (ASSOCIATED(ptr, target)) THEN ``` An alternative way to initialize a pointer, also in a specification statement, is to use the `NULL` function: -``` fortran +```f90 REAL, POINTER, DIMENSION(:) :: vector => NULL() ! compile time vector => NULL() ! run time ``` @@ -2049,7 +2049,7 @@ matrix manipulation *y = B C z*, we can write the following code (although, in this case, the same result could be achieved more simply by other means): -``` fortran +```f90 REAL, TARGET :: b(10,10), c(10,10), r(10), s(10), z(10) REAL, POINTER :: a(:,:), x(:), y(:) INTEGER mult @@ -2071,7 +2071,7 @@ END DO For objects of derived type we have to distinguish between pointer and normal assignment. In -``` fortran +```f90 TYPE(entry), POINTER :: first, current : first => current @@ -2079,13 +2079,13 @@ first => current the assignment causes first to point at current, whereas -``` fortran +```f90 first = current ``` causes current to overwrite first and is equivalent to -``` fortran +```f90 first%value = current%value first%index = current%index first%next => current%next @@ -2106,7 +2106,7 @@ pointer, If the dummy argument is not a pointer, it becomes associated with the target of the actual argument: -``` fortran +```f90 REAL, POINTER :: a (:,:) : ALLOCATE (a(80, 80)) @@ -2123,7 +2123,7 @@ Function results may also have the `POINTER` attribute; this is useful if the result size depends on calculations performed in the function, as in -``` fortran +```f90 USE data_handler REAL x(100) REAL, POINTER :: y(:) @@ -2133,7 +2133,7 @@ y => compact(x) where the module data_handler contains -``` fortran +```f90 FUNCTION compact(x) REAL, POINTER :: compact(:) REAL x(:) @@ -2152,13 +2152,13 @@ defined target). These do not exist as such: given -``` fortran +```f90 TYPE(entry) :: rows(n) ``` then -``` fortran +```f90 rows%next ! illegal ``` @@ -2166,7 +2166,7 @@ would be such an object, but with an irregular storage pattern. For this reason they are not allowed. However, we can achieve the same effect by defining a derived data type with a pointer as its sole component: -``` fortran +```f90 TYPE row REAL, POINTER :: r(:) END TYPE @@ -2174,13 +2174,13 @@ END TYPE and then defining arrays of this data type -``` fortran +```f90 TYPE(row) :: s(n), t(n) ``` where the storage for the rows can be allocated by, for instance, -``` fortran +```f90 DO i = 1, n ALLOCATE (t(i)%r(1:i)) ! Allocate row i of length i END DO @@ -2188,13 +2188,13 @@ END DO The array assignment -``` fortran +```f90 s = t ``` is then equivalent to the pointer assignments -``` fortran +```f90 s(i)%r => t(i)%r ``` @@ -2204,19 +2204,19 @@ for all components. Given an array -``` fortran +```f90 REAL, TARGET :: table(100,100) ``` that is frequently referenced with the fixed subscripts -``` fortran +```f90 table(m:n, p:q) ``` these references may be replaced by -``` fortran +```f90 REAL, DIMENSION(:, :), POINTER :: window : window => table(m:n, p:q) @@ -2224,13 +2224,13 @@ window => table(m:n, p:q) The subscripts of window are -``` fortran +```f90 1:n-m+1, 1:q-p+1 ``` . Similarly, for -``` fortran +```f90 tar%u ``` @@ -2238,13 +2238,13 @@ tar%u already), we can use, say, -``` fortran +```f90 taru => tar%u ``` to point at all the u components of tar, and subscript it as -``` fortran +```f90 taru(1, 2) ``` @@ -2253,7 +2253,7 @@ The subscripts are as those of tar itself. (This replaces yet more of In the pointer association -``` fortran +```f90 pointer => array_expression ``` @@ -2266,7 +2266,7 @@ lower bounds default to 1. 2003 allows specifying arbitrary lower bounds on pointer association, like -``` fortran +```f90 window(r:,s:) => table(m:n,p:q) ``` @@ -2276,7 +2276,7 @@ does not have this feature; however, it can be simulated using the following trick (based on the pointer association rules for assumed shape array dummy arguments): -``` fortran +```f90 FUNCTION remap_bounds2(lb1,lb2,array) RESULT(ptr) INTEGER, INTENT(IN) :: lb1,lb2 REAL, DIMENSION(lb1:,lb2:), INTENT(IN), TARGET :: array @@ -2299,7 +2299,7 @@ deal only with their general classification and with those that have so far been omitted. All intrinsic procedures can be used with keyword arguments: -``` fortran +```f90 CALL DATE_AND_TIME (TIME=t) ``` @@ -2339,7 +2339,7 @@ Bit manipulation Transfer function, as in -``` fortran +```f90 INTEGER :: i = TRANSFER('abcd', 0) ``` @@ -2365,7 +2365,7 @@ These examples illustrate various forms of I/O lists with some simple formats (see below): -``` fortran +```f90 INTEGER :: i REAL, DIMENSION(10) :: a CHARACTER(len=20) :: word @@ -2379,7 +2379,7 @@ PRINT "(3f10.3)", a(1)*a(2)+i, SQRT(a(3:4)) Variables, but not expressions, are equally valid in input statements using the `READ` statement: -``` fortran +```f90 READ "(i10)", i ``` @@ -2392,13 +2392,13 @@ transfer takes place between the file and the targets. An item of derived type is treated as if the components were specified in the same order as in the type declaration, so -``` fortran +```f90 read "(8f10.5)", p, t ! types point and triangle ``` has the same effect as the statement -``` fortran +```f90 READ "(8f10.5)", p%x, p%y, t%a%x, t%a%y, t%b%x, & t%b%y, t%c%x, t%c%y ``` @@ -2412,7 +2412,7 @@ an item corresponds to no actual data transfer. The format specification may also be given in the form of a character expression: -``` fortran +```f90 CHARACTER(len=*), parameter :: form = "(f10.3)" : PRINT form, q @@ -2423,7 +2423,7 @@ or as an asterisk this is a type of I/O known as *list-directed* I/O below), in which the format is defined by the computer system: -``` fortran +```f90 PRINT *, "Square-root of q = ", SQRT(q) ``` @@ -2433,7 +2433,7 @@ number*. However, two I/O statements, `PRINT` and a variant of `READ`, do not reference any unit number: this is referred to as terminal I/O. Otherwise the form is: -``` fortran +```f90 READ (UNIT=4, FMT="(f10.3)") q READ (UNIT=nunit, FMT="(f10.3)") q READ (UNIT=4*i+j, FMT="(f10.3)") a @@ -2445,7 +2445,7 @@ error, keyboard and terminal, respectively). An asterisk is a variantagain from the keyboard: -``` fortran +```f90 READ (UNIT=*, FMT="(f10.3)") q ``` @@ -2453,7 +2453,7 @@ A read with a unit specifier allows exception handling: -``` fortran +```f90 READ (UNIT=NUNIT, FMT="(3f10.3)", IOSTAT=ios) a,b,c IF (ios == 0) THEN ! Successful read - continue execution. @@ -2467,7 +2467,7 @@ END IF There a second type of formatted output statement, the `WRITE` statement: -``` fortran +```f90 WRITE (UNIT=nout, FMT="(10f10.3)", IOSTAT=ios) a ``` @@ -2477,7 +2477,7 @@ These allow format conversion between various representations to be carried out by the program in a storage area defined within the program itself. -``` fortran +```f90 INTEGER, DIMENSION(30) :: ival INTEGER :: key CHARACTER(LEN=30) :: buffer @@ -2495,7 +2495,7 @@ element. An example using a `WRITE` statement is -``` fortran +```f90 INTEGER :: day REAL :: cash CHARACTER(LEN=50) :: line @@ -2512,7 +2512,7 @@ that might write An example of a read without a specified format for input is -``` fortran +```f90 INTEGER :: i REAL :: a COMPLEX, DIMENSION(2) :: field @@ -2525,7 +2525,7 @@ READ *, i, a, field, flag, title, word If this reads the input record -``` fortran +```f90 10 6.4 (1.0,0.0) (2.0,0.0) t test/ ``` @@ -2545,7 +2545,7 @@ always repositions the file after the last record accessed, a non-advancing I/O statement performs no such repositioning and may therefore leave the file positioned within a record. -``` fortran +```f90 CHARACTER(LEN=3) :: key INTEGER :: u, s, ios : @@ -2566,7 +2566,7 @@ In order to write a prompt to a terminal screen and to read from the next character position on the screen without an intervening line-feed, we can write -``` fortran +```f90 WRITE (UNIT=*, FMT="(a)", ADVANCE="no") "enter next prime number:" READ (UNIT=*, FMT="(i10)") prime_number ``` @@ -2585,13 +2585,13 @@ title="below">below) may have a repeat count, and a repeat count can also apply to a group of edit descriptors, enclosed in parentheses, with nesting: -``` fortran +```f90 PRINT "(2(2i5,2f8.2))", i(1),i(2),a(1),a(2), i(3),i(4),a(3),a(4) ``` Entire format specifications can be repeated: -``` fortran +```f90 PRINT "(10i8)", (/ (i(j), j=1,200) /) ``` @@ -2612,7 +2612,7 @@ generated by a program on one computer, to be read back on the same computer or another computer using the same internal number representations: -``` fortran +```f90 OPEN(UNIT=4, FILE='test', FORM='unformatted') READ(UNIT=4) q WRITE(UNIT=nout, IOSTAT=ios) a ! no fmt= @@ -2625,7 +2625,7 @@ all the records have the same length, and each record is identified by an index number. It is possible to write, read, or re-write any specified record without regard to position. -``` fortran +```f90 INTEGER, PARAMETER :: nunit=2, length=100 REAL, DIMENSION(length) :: a REAL, DIMENSION(length+1:2*length) :: b @@ -2665,14 +2665,14 @@ The statement is used to connect an external file to a unit, create a file that is preconnected, or create a file and connect it to a unit. The syntax is -``` fortran +```f90 OPEN (UNIT=u, STATUS=st, ACTION=act [,olist]) ``` where `olist` is a list of optional specifiers. The specifiers may appear in any order. -``` fortran +```f90 OPEN (UNIT=2, IOSTAT=ios, FILE="cities", STATUS="new", ACCESS="direct", & ACTION="readwrite", RECL=100) ``` @@ -2683,13 +2683,13 @@ Other specifiers are `FORM` and `POSITION`. This is used to disconnect a file from a unit. -``` fortran +```f90 CLOSE (UNIT=u [, IOSTAT=ios] [, STATUS=st]) ``` as in -``` fortran +```f90 CLOSE (UNIT=2, IOSTAT=ios, STATUS="delete") ``` @@ -2707,25 +2707,25 @@ when used to write an unformatted record. For inquire by unit -``` fortran +```f90 INQUIRE (UNIT=u, ilist) ``` or for inquire by file -``` fortran +```f90 INQUIRE (FILE=fln, ilist) ``` or for inquire by I/O list -``` fortran +```f90 INQUIRE (IOLENGTH=length) olist ``` As an example -``` fortran +```f90 LOGICAL :: ex, op CHARACTER (LEN=11) :: nam, acc, seq, frm INTEGER :: irec, nr @@ -2735,7 +2735,7 @@ INQUIRE (UNIT=2, EXIST=ex, OPENED=op, NAME=nam, ACCESS=acc, SEQUENTIAL=seq, & yields -``` fortran +```f90 ex .true. op .true. nam cities From 3429d11b06c348f4a03902f209657a51a4220915 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sun, 2 Mar 2025 19:56:33 +0100 Subject: [PATCH 05/10] install index.md Creation of the index.md file, already anticipating the first chapter to be added. Corresponding cut in the container file. --- source/learn/f95_features/f95_features.md | 45 ---------------- source/learn/f95_features/index.md | 64 +++++++++++++++++++++++ 2 files changed, 64 insertions(+), 45 deletions(-) create mode 100644 source/learn/f95_features/index.md diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md index b63ac4093378..4042cac3e531 100644 --- a/source/learn/f95_features/f95_features.md +++ b/source/learn/f95_features/f95_features.md @@ -1,48 +1,3 @@ -# Fortran 95 language features - -This is an overview of **Fortran 95 language features** which is based -upon the standards document[^iso_1539_1997] which has been replaced byi -a newer version.[^iso_1539_2023] Included are the additional features of -TR-15581:Enhanced Data Type Facilities, which have been universally -implemented. Old features that have been superseded by new ones are not -described few of those historic features are used in modern programs -although most have been retained in the language to maintain -[backward_compatibility](https://en.wikipedia.org/wiki/Backward_compatibility). -The additional features of subsequent standards, up to Fortran 2023, are -described in the Fortran 2023 standard document, ISO/IEC -1539-1:2023.[^iso_1539_2023] Some of its new features are still being -implemented in compilers.[^Fortran_plus] Details can also be found in a -range of textbooks, for instance[^OOPvF][^OOPC][^Chapman] and see the\ -list at Fortran Resources.[^Fortran_plus_18] Sources for the description -in the sections below can be found in the standards -documents,[^iso_1539_2023] textbooks[^OOPvF][^OOPC][^Chapman] as well as -the **Bibliography**. - -The booklet is based on Wikipedia's article -[Fortran 95 language -features](https://en.wikipedia.org/wiki/Fortran_95_language_features), -last edit by February 25, 2025 16:08 UTC. - -[^iso_1539_1997]: [ISO/IEC 1539-1:1997](https://www.iso.org/standard/26933.html) - -[^iso_1539_2023]: [ISO/IEC 1539-1:2023](https://www.iso.org/standard/82170.html) - -[^Fortran_plus]: [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/) - -[^OOPvF]: ["Features of Programming Languages"](https://doi.org/10.1017/cbo9780511530111.005), -Object-Oriented Programming via Fortran 90/95, Cambridge University Press, -pp. 56–118. - -[^OOPC]: ["Object-Oriented Programming Concepts"](https://doi.org/10.1017/cbo9780511530111.004), -Object-Oriented Programming via Fortran 90/95, Cambridge University Press, -pp. 36–55 - -[^Chapman]: Chapman, Stephen J. (2004). -[Fortran 90/95 for scientists and engineers](https://www.worldcat.org/title/ocm52465017) -(2nd ed.). Boston: McGraw-Hill Higher Education. ISBN 978-0-07-282575-6. - -[^Fortran_plus_18]: [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/), -p. 18 ## Language elements diff --git a/source/learn/f95_features/index.md b/source/learn/f95_features/index.md new file mode 100644 index 000000000000..0995a603162d --- /dev/null +++ b/source/learn/f95_features/index.md @@ -0,0 +1,64 @@ +# Fortran 95 language features + +:::{toctree} +:maxdepth: 2 +:hidden: +Language elements +::: + +This is an overview of **Fortran 95 language features** which is based +upon the standards document[^iso_1539_1997] which has been replaced byi +a newer version.[^iso_1539_2023] Included are the additional features of +TR-15581:Enhanced Data Type Facilities, which have been universally +implemented. Old features that have been superseded by new ones are not +described few of those historic features are used in modern programs +although most have been retained in the language to maintain +[backward_compatibility](https://en.wikipedia.org/wiki/Backward_compatibility). +The additional features of subsequent standards, up to Fortran 2023, are +described in the Fortran 2023 standard document, ISO/IEC +1539-1:2023.[^iso_1539_2023] Some of its new features are still being +implemented in compilers.[^Fortran_plus] Details can also be found in a +range of textbooks, for instance[^OOPvF][^OOPC][^Chapman] and see the\ +list at Fortran Resources.[^Fortran_plus_18] Sources for the description +in the sections below can be found in the standards +documents,[^iso_1539_2023] textbooks[^OOPvF][^OOPC][^Chapman] as well as +the **Bibliography**. + +The booklet is based on Wikipedia's article +[Fortran 95 language +features](https://en.wikipedia.org/wiki/Fortran_95_language_features), +last edit by February 25, 2025 16:08 UTC. + +[^mfe]: + Metcalf, Michael; Reid, John; Cohen, Malcolm; Bader, Reinhold (2023). + _Modern Fortran Explained._ Numerical Mathematics and Scientific Computation. + Oxford University Press. + [ISBN 978-0-19-887657-1](https://en.wikipedia.org/wiki/Special:BookSources/978-0-19-887657-1). + +[^iso_1539_1997]: + [ISO/IEC 1539-1:1997](https://www.iso.org/standard/26933.html) + +[^iso_1539_2023]: + [ISO/IEC 1539-1:2023](https://www.iso.org/standard/82170.html) + +[^Fortran_plus]: + [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/) + +[^OOPvF]: + ["Features of Programming Languages"](https://doi.org/10.1017/cbo9780511530111.005), + Object-Oriented Programming via Fortran 90/95, Cambridge University Press, + pp. 56–118. + +[^OOPC]: + ["Object-Oriented Programming Concepts"](https://doi.org/10.1017/cbo9780511530111.004), + Object-Oriented Programming via Fortran 90/95, Cambridge University Press, + pp. 36–55 + +[^Chapman]: + Chapman, Stephen J. (2004). + [Fortran 90/95 for scientists and engineers](https://www.worldcat.org/title/ocm52465017) + (2nd ed.). Boston: McGraw-Hill Higher Education. ISBN 978-0-07-282575-6. + +[^Fortran_plus_18]: + [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/), +p. 18 From 6888e51679a14d92860ad9b470a072a11b6b7fea Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sun, 2 Mar 2025 19:59:20 +0100 Subject: [PATCH 06/10] update index of learn.md The index of booklets in `learn.md` was amended by a link about the new booklet under construction. Signed-off-by: Norwid Behrnd --- source/learn.md | 1 + 1 file changed, 1 insertion(+) diff --git a/source/learn.md b/source/learn.md index a39a7db50256..894147707162 100644 --- a/source/learn.md +++ b/source/learn.md @@ -186,4 +186,5 @@ learn/best_practices/index learn/intrinsics/index learn/rosetta_stone learn/oop_features_in_fortran/index +learn/f95_features/index ::: From 6634c7ccf1db9c9a463bcb48e4bcdde03aaf01ce Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Sun, 2 Mar 2025 20:05:30 +0100 Subject: [PATCH 07/10] language_elements.md: lint with mdl Linting with markdownlint (version 0.13.0) as packaged by Debian Linux[1] except for any kind of links, tables and checks on snippets of Fortran. [1] https://tracker.debian.org/pkg/ruby-mdl Signed-off-by: Norwid Behrnd --- data/learning.yml | 15 + source/learn/f95_features/array_handling.md | 417 +++ .../learn/f95_features/control_statements.md | 97 + source/learn/f95_features/data_transfer.md | 297 +++ .../expressions_and_assignments.md | 299 +++ source/learn/f95_features/f95_features.md | 2314 ----------------- source/learn/f95_features/fprettify.rc | 36 + source/learn/f95_features/index.md | 7 + .../f95_features/intrinsic_procedures.md | 60 + .../learn/f95_features/language_elements.md | 527 ++++ source/learn/f95_features/pointers.md | 332 +++ .../program_units_and_procedures.md | 378 +++ 12 files changed, 2465 insertions(+), 2314 deletions(-) create mode 100644 source/learn/f95_features/array_handling.md create mode 100644 source/learn/f95_features/control_statements.md create mode 100644 source/learn/f95_features/data_transfer.md create mode 100644 source/learn/f95_features/expressions_and_assignments.md create mode 100644 source/learn/f95_features/fprettify.rc create mode 100644 source/learn/f95_features/intrinsic_procedures.md create mode 100644 source/learn/f95_features/language_elements.md create mode 100644 source/learn/f95_features/pointers.md create mode 100644 source/learn/f95_features/program_units_and_procedures.md diff --git a/data/learning.yml b/data/learning.yml index 6d1bcfca7633..db2145e60496 100644 --- a/data/learning.yml +++ b/data/learning.yml @@ -286,6 +286,21 @@ books: - /learn/oop_features_in_fortran/object_oriented_programming_techniques - /learn/oop_features_in_fortran/performance_and_ease_of_use + - title: Fortran 95 language features + description: Wikipedia's article about the Fortran 95 standard + category: Fortran Documentation + link: /learn/f95_features + pages: + - /learn/f95_features/ + - /learn/f95_features/language_elments + - /learn/f95_features/expressions_and_assignments + - /learn/f95_features/control_statements + - /learn/f95_features/programm_units_and_procedures + - /learn/f95_features/array_handling + - /learn/f95_features/pointers + - /learn/f95_features/intrinsic_procedures + - /learn/f95_features/data_transfer + # Web links listed at the bottom of the 'Learn' landing page # reference-links: diff --git a/source/learn/f95_features/array_handling.md b/source/learn/f95_features/array_handling.md new file mode 100644 index 000000000000..01c081b9994d --- /dev/null +++ b/source/learn/f95_features/array_handling.md @@ -0,0 +1,417 @@ +# Array handling + +Array handling is included in Fortran for two main reasons: + +- the notational convenience it provides, bringing the code closer to + the underlying mathematical form; +- for the additional optimization opportunities it gives compilers + (although there are plenty of opportunities for degrading + optimization too!). + +At the same time, major extensions of the functionality in this area +have been added. We have already met whole arrays above +#Arrays 1 and +here +#Arrays 2 - +now we develop the theme. + +## Zero-sized arrays + +A zero-sized array is handled by Fortran as a legitimate object, without +special coding by the programmer. Thus, in + +```f90 +do i = 1, n + x(i) = b(i) / a(i, i) + b(i + 1:n) = b(i + 1:n) - a(i + 1:n, i) * x(i) +end do +``` + +no special code is required for the final iteration where `i = n`. We +note that a zero-sized array is regarded as being defined; however, an +array of shape `(0,2)` is not conformable with one of shape `(0,3)`, +whereas + +```f90 +x(1:0) = 3 +``` + +is a valid 'do nothing' statement. + +## Assumed-shape arrays + +These are an extension and replacement for assumed-size arrays. Given an +actual argument like: + +```f90 +real, dimension(0:10, 0:20) :: a +: +call sub(a) +``` + +the corresponding dummy argument specification defines only the type and +rank of the array, not its shape. This information has to be made +available by an explicit interface, often using an interface block (see +[Interface blocks](interface_blocks). +Thus we write just + +```f90 +subroutine sub(da) + real, dimension(:, :) :: da +``` + +and this is as if `da` were dimensioned `(11,21)`. However, we can specify +any lower bound and the array maps accordingly. + +```f90 +real, dimension(0:, 0:) :: da +``` + +The shape, not bounds, is passed, where the default lower bound is 1 and +the default upper bound is the corresponding extent. + +## Automatic arrays + +A partial replacement for the uses to which `equivalence` was put is +provided by this facility, useful for local, temporary arrays, as in + +```f90 +subroutine swap(a, b) + real, dimension(:) :: a, b + real, dimension(size(a)) :: work + work = a + a = b + b = work +end subroutine swap +``` + +The actual storage is typically maintained on a stack. + +## `allocatable` and `allocate` + +Fortran provides dynamic allocation of storage; it relies on a heap +storage mechanism (and replaces another use of `equivalence`). An +example for establishing a work array for a whole program is + +```f90 +module work_array + integer n + real, dimension(:, :, :), allocatable :: work +end module + +program main + use work_array + read (input, *) n + allocate (work(n, 2 * n, 3 * n), STAT=status) + : + deallocate (work) +``` + +The work array can be propagated through the whole program via a `use` +statement in each program unit. We may specify an explicit lower bound +and allocate several entities in one statement. To free dead storage we +write, for instance, + +```f90 +deallocate(a, b) +``` + +Deallocation of arrays is automatic when they go out of scope. + +## Elemental operations, assignments and procedures + +We have already met whole array assignments and operations: + +```f90 +real, dimension(10) :: a, b +a = 0. ! scalar broadcast; elemental assignment +b = sqrt(a) ! intrinsic function result as array object +``` + +In the second assignment, an intrinsic function returns an array-valued +result for an array-valued argument. We can write array-valued functions +ourselves (they require an explicit interface): + +```f90 +program test + real, dimension(3) :: a = (/1., 2., 3./), & + b = (/2., 2., 2./), r + r = f(a, b) + print*,r +contains + function f(c, d) + real, dimension(:) :: c, d + real, dimension(size(c)) :: f + f = c * d ! (or some more useful function of c and d) + end function f +end program test +``` + +Elemental procedures are specified with scalar dummy arguments that may +be called with array actual arguments. In the case of a function, the +shape of the result is the shape of the array arguments. + +Most intrinsic functions are elemental and Fortran 95 extends this +feature to non-intrinsic procedures, thus providing the effect of +writing, in Fortran 90, 22 different versions, for ranks 0-0, 0-1, 1-0, +1-1, 0-2, 2-0, 2-2, ... 7-7, and is further an aid to optimization on +parallel processors. An elemental procedure must be pure. + +```f90 +elemental subroutine swap(a, b) + real, intent(INOUT) :: a, b + real :: work + work = a + a = b + b = work +end subroutine swap +``` + +The dummy arguments cannot be used in specification expressions (see +above) except as arguments to certain intrinsic +functions (`bit_size`, `kind`, `len`, and the numeric inquiry ones, (see +below). + +## `where` + +Often, we need to mask an assignment. This we can do using the `where`, +either as a statement: + +```f90 +where (a /= 0.0) a = 1.0 / a ! avoid division by 0 +``` + +(note: the test is element-by-element, not on whole array), or as a +construct: + +```f90 +where (a /= 0.0) + a = 1.0 / a + b = a ! all arrays same shape +end where +``` + +or + +```f90 +where (a /= 0.0) + a = 1.0 / a +elsewhere + a = huge(a) +end where +``` + +Further: + +- it is permitted to mask not only the `where` statement of the + `where` construct, but also any `elsewhere` statement that it + contains; +- a `where` construct may contain any number of masked `elsewhere` + statements but at most one `elsewhere` statement without a mask, and + that must be the final one; +- `where` constructs may be nested within one another, just `forall` + constructs; +- a `where` assignment statement is permitted to be a defined + assignment, provided that it is elemental; +- a `where` construct may be named in the same way as other + constructs. + +## The `forall` statement and construct + +When a `do` construct is executed, each successive iteration is +performed in order and one after the otheran impediment to optimization +on a parallel processor. + +```f90 +forall (i=1:n) a(i, i) = x(i) +``` + +where the individual assignments may be carried out in any order, and +even simultaneously. The `forall` may be considered to be an array +assignment expressed with the help of indices. + +```f90 +forall (i=1:n, j=1:n, y(i, j) /= 0.) x(j, i) = 1.0 / y(i, j) +``` + +with masking condition. + +The `forall` construct allows several assignment statements to be +executed in order. + +```f90 +a(2:n - 1, 2:n - 1) = a(2:n - 1, 1:n - 2) + a(2:n - 1, 3:n) + & + & a(1:n - 2, 2:n - 1) + a(3:n, 2:n - 1) +b(2:n - 1, 2:n - 1) = a(2:n - 1, 2:n - 1) +``` + +is equivalent to the array assignments + +```f90 +forall (i=2:n - 1, j=2:n - 1) + a(i, j) = a(i, j - 1) + a(i, j + 1) + a(i - 1, j) + a(i + 1, j) + b(i, j) = a(i, j) +end forall +``` + +The `forall` version is more readable. + +Assignment in a `forall` is like an array assignment: as if all the +expressions were evaluated in any order, held in temporary storage, then +all the assignments performed in any order. The first statement must +fully complete before the second can begin. + +A `forall` may be nested, and may include a `where`. Procedures +referenced within a `forall` must be pure. + +## Array elements + +For a simple case, given + +```f90 +real, dimension(100, 100) :: a +``` + +we can reference a single element as, for instance, `a(1, 1)`. For a +derived-data type like + +```f90 +type fun_del + real :: u + real, dimension(3) :: du +end type fun_del +``` + +we can declare an array of that type: + +```f90 +type(fun_del), dimension(10, 20) :: tar +``` + +and a reference like + +```f90 +tar(n, 2) +``` + +is an element (a scalar!) of type `fun_del`, but + +```f90 +tar(n, 2)%du +``` + +is an array of type `real`, and + +```f90 +tar(n, 2)%du(2) +``` + +is an element of it. The basic rule to remember is that an array element +always has a subscript or subscripts qualifying at least the last name. + +## Array subobjects (sections) + +The general form of subscript for an array section is + +` [`*`lower`*`] : [`*`upper`*`] [:`*`stride`*`]` + +(where `[...]` indicates an optional item) as in + +```f90 +real a(10, 10) +a(i, 1:n) ! part of one row +a(1:m, j) ! part of one column +a(i, :) ! whole row +a(i, 1:n:3) ! every third element of row +a(i, 10:1:-1) ! row in reverse order +a( (/ 1, 7, 3, 2 /), 1) ! vector subscript +a(1, 2:11:2) ! 11 is legal as not referenced +a(:, 1:7) ! rank two section +``` + +Note that a vector subscript with duplicate values cannot appear on the +left-hand side of an assignment as it would be ambiguous. Thus, + +```f90 +b( (/ 1, 7, 3, 7 /) ) = (/ 1, 2, 3, 4 /) +``` + +is illegal. Also, a section with a vector subscript must not be supplied +as an actual argument to an `out` or `inout` dummy argument. Arrays of +arrays are not allowed: + +```f90 +tar%du ! illegal +``` + +We note that a given value in an array can be referenced both as an +element and as a section: + +```f90 +a(1, 1) ! scalar (rank zero) +a(1:1, 1) ! array section (rank one) +``` + +depending on the circumstances or requirements. By qualifying objects of +derived type, we obtain elements or sections depending on the rule +stated earlier: + +```f90 +tar%u ! array section (structure component) +tar(1, 1)%u ! component of an array element +``` + +## Arrays intrinsic functions + +### Vector and matrix multiply + +| `dot_product` | Dot product of 2 rank-one arrays | +|---------------|----------------------------------| +| `matmul` | Matrix multiplication | + +### Array reduction + +| `all` | True if all values are true | +|-----------|-------------------------------------------------------------| +| `any` | True if any value is true. Example: `if (any( a > b)) then` | +| `count` | Number of true elements in array | +| `maxval` | Maximum value in an array | +| `minval` | Minimum value in an array | +| `product` | Product of array elements | +| `sum` | Sum of array elements | + +### Array inquiry + +| `allocated` | Array allocation status | +|-------------|--------------------------------------| +| `lbound` | Lower dimension bounds of an array | +| `shape` | Shape of an array (or scalar) | +| `size` | Total number of elements in an array | +| `ubound` | Upper dimension bounds of an array | + +### Array construction + +| `merge` | Merge under mask | +|----------|------------------------------------------------------| +| `pack` | Pack an array into an array of rank one under a mask | +| `spread` | Replicate array by adding a dimension | +| `unpack` | Unpack an array of rank one into an array under mask | + +### Array reshape + +| `reshape` | Reshape an array | +|-----------|------------------| + +### Array manipulation + +| `cshift` | Circular shift | +|-------------|-----------------------------------| +| `eoshift` | End-off shift | +| `transpose` | Transpose of an array of rank two | + +### Array location + +| `maxloc` | Location of first maximum value in an array | +|----------|---------------------------------------------| +| `minloc` | Location of first minimum value in an array | diff --git a/source/learn/f95_features/control_statements.md b/source/learn/f95_features/control_statements.md new file mode 100644 index 000000000000..9adbf8e07149 --- /dev/null +++ b/source/learn/f95_features/control_statements.md @@ -0,0 +1,97 @@ +# Control statements + +## Branching and conditions + +The simple `go to` *label* exists, but is usually avoided in most cases, +a more specific branching construct will accomplish the same logic with +more clarity. + +The simple conditional test is the `if` statement: + +```f90 +if (a > b) x = y +``` + +A full-blown `if` construct is illustrated by + +```f90 +if (i < 0) then + if (j < 0) then + x = 0. + else + z = 0. + end if +else if (k < 0) then + z = 1. +else + x = 1. +end if +``` + +## `case` construct + +The `case` construct is a replacement for the computed `goto`, but is +better structured and does not require the use of statement labels: + +```f90 +select case (number) ! number of type integer +case (:-1) ! all values below 0 + n_sign = -1 +case (0) ! only 0 + n_sign = 0 +case (1:) ! all values above 0 + n_sign = 1 +end select +``` + +Each `case` selector list may contain a list and/or range of integers, +character or logical constants, whose values may not overlap within or +between selectors: + +```f90 +case (1, 2, 7, 10:17, 23) +``` + +A default is available: + +```f90 +case default +``` + +There is only one evaluation, and only one match. + +## `do` construct + +A simplified but sufficient form of the `do` construct is illustrated by + +```f90 +outer: do + inner: do i = j, k, l ! from j to k in steps of l (l is optional) + : + if (...) cycle + : + if (...) exit outer + : + end do inner +end do outer +``` + +where we note that loops may be optionally named so that any `exit` or +`cycle` statement may specify which loop is meant. + +Many, but not all, simple loops can be replaced by array expressions and +assignments, or by new intrinsic functions. For instance + +```f90 +tot = 0. + +do i = m, n + tot = tot + a(i) +end do +``` + +becomes simply + +```f90 +tot = sum(a(m:n)) +``` diff --git a/source/learn/f95_features/data_transfer.md b/source/learn/f95_features/data_transfer.md new file mode 100644 index 000000000000..25e3f98c9b69 --- /dev/null +++ b/source/learn/f95_features/data_transfer.md @@ -0,0 +1,297 @@ +# Data transfer + +## Formatted input/output + +These examples illustrate various forms of I/O lists with some simple +formats (see +below): + +```f90 +integer :: i +real, dimension(10) :: a +character(len=20) :: word +print "(i10)", i +print "(10f10.3)", a +print "(3f10.3)", a(1), a(2), a(3) +print "(a10)", word(5:14) +print "(3f10.3)", a(1) * a(2) + i, sqrt(a(3:4)) +``` + +Variables, but not expressions, are equally valid in input statements +using the `read` statement: + +```f90 +read "(i10)", i +``` + +If an array appears as an item, it is treated as if the elements were +specified in array element order. + +Any pointers in an I/O list must be associated with a target, and +transfer takes place between the file and the targets. + +An item of derived type is treated as if the components were specified +in the same order as in the type declaration, so + +```f90 +read "(8f10.5)", p, t ! types point and triangle +``` + +has the same effect as the statement + +```f90 +read "(8f10.5)", p%x, p%y, t%a%x, t%a%y, t%b%x, & + t%b%y, t%c%x, t%c%y +``` + +An object in an I/O list is not permitted to be of a derived type that +has a pointer component at any level of component selection. + +Note that a zero-sized array may occur as an item in an I/O list. Such +an item corresponds to no actual data transfer. + +The format specification may also be given in the form of a character +expression: + +```f90 +character(len=*), parameter :: form = "(f10.3)" +: +print form, q +``` + +or as an asterisk this is a type of I/O known as *list-directed* I/O +(see +below), +in which the format is defined by the computer system: + +```f90 +print *, "Square-root of q = ", sqrt(q) +``` + +Input/output operations are used to transfer data between the storage of +an executing program and an external medium, specified by a *unit +number*. However, two I/O statements, `print` and a variant of `read`, +do not reference any unit number: this is referred to as terminal I/O. +Otherwise the form is: + +```f90 +read (UNIT=4, FMT="(f10.3)") q +read (UNIT=newunit, FMT="(f10.3)") q +read (UNIT=4 * i + j, FMT="(f10.3)") a +``` + +where `unit=` is optional. The value may be any nonnegative integer +allowed by the system for this purpose (but `0`, `5` and `6` often denote the +error, keyboard and terminal, respectively). + +An asterisk is a variantagain from the keyboard: + +```f90 +read (UNIT=*, FMT="(f10.3)") q +``` + +A read with a unit specifier allows +exception handling: + +```f90 +read (UNIT=NUNIT, FMT="(3f10.3)", IOSTAT=ios) a, b, c +if (ios == 0) then + ! Successful read - continue execution. + : +else + ! Error condition - take appropriate action. + call error(ios) +end if +``` + +There a second type of formatted output statement, the `write` +statement: + +```f90 +write (UNIT=nout, FMT="(10f10.3)", IOSTAT=ios) a +``` + +## Internal files + +These allow format conversion between various representations to be +carried out by the program in a storage area defined within the program +itself. + +```f90 +integer, dimension(30) :: ival +integer :: key +character(LEN=30) :: buffer +character(LEN=6), dimension(3), parameter :: form = (/"(30i1)", "(15i2)", "(10i3)"/) + +read (UNIT=*, FMT="(a30,i1)") buffer, key +read (UNIT=buffer, FMT=form(key)) ival(1:30 / key) +``` + +If an internal file is a scalar, it has a single record whose length is +that of the scalar. + +If it is an array, its elements, in array element order, are treated as +successive records of the file and each has length that of an array +element. + +An example using a `write` statement is + +```f90 +integer :: day +real :: cash +character(LEN=50) :: line +: +! write into line +write (UNIT=line, FMT="(a, i2, a, f8.2, a)") "Takings for day ", day, & + & " are ", cash, " dollars" +``` + +that might write + +```shell +Takings for day 3 are 4329.15 dollars +``` + +## List-directed I/O + +An example of a read without a specified format for input is + +```f90 +integer :: i +real :: a +complex, dimension(2) :: field +logical :: flag +character(LEN=12) :: title +character(LEN=4) :: word +: +read *,i, a, field, flag, title, word +``` + +If this reads the input record + +```f90 +10 6.4(1.0, 0.0) (2.0, 0.0) t test / +``` + +(in which blanks are used as separators), then `i`, `a`, `field`, +`flag`, and `title` will acquire the values 10, 6.4, (1.0,0.0) and +(2.0,0.0), `.true.` and `test` respectively, while `word` remains +unchanged. + +Quotation marks or apostrophes are required as delimiters for a string +that contains a blank. + +## Non-advancing I/O + +This is a form of reading and writing without always advancing the file +position to ahead of the next record. Whereas an advancing I/O statement +always repositions the file after the last record accessed, a +non-advancing I/O statement performs no such repositioning and may +therefore leave the file positioned within a record. + +```f90 +character(LEN=3) :: key +integer :: u, s, ios +: +read (UNIT=u, FMT="(a3)", ADVANCE="no", SIZE=s, IOSTAT=ios) key +if (ios == 0) then + : +else + ! key is not in one record + key(s + 1:) = "" + : +end if +``` + +A non-advancing read might read the first few characters of a record and +a normal read the remainder. + +In order to write a prompt to a terminal screen and to read from the +next character position on the screen without an intervening line-feed, +we can write + +```f90 +write (UNIT=*, FMT="(a)", ADVANCE="no") "enter next prime number:" +read (UNIT=*, FMT="(i10)") prime_number +``` + +Non-advancing I/O is for external files, and is not available for +list-directed I/O. + +## Edit descriptors + +It is possible to specify that an edit descriptor be repeated a +specified number of times, using a *repeat count*: `10f12.3` + +The slash edit descriptor (see +below) may have a repeat count, and a repeat count can +also apply to a group of edit descriptors, enclosed in parentheses, with +nesting: + +```f90 +print "(2(2i5,2f8.2))", i(1),i(2),a(1),a(2), i(3),i(4),a(3),a(4) +``` + +Entire format specifications can be repeated: + +```f90 +print "(10i8)", (/ (i(j), j=1,200) /) +``` + +writes 10 integers, each occupying 8 character positions, on each of 20 +lines (repeating the format specification advances to the next line). + +### Data edit descriptors + +### Control edit descriptors + +*Control edit descriptors setting conditions*: *Control edit descriptors +for immediate processing*: + +## Unformatted I/O + +This type of I/O should be used only in cases where the records are +generated by a program on one computer, to be read back on the same +computer or another computer using the same internal number +representations: + +```f90 +open (UNIT=4, FILE='test', FORM='unformatted') +read (UNIT=4) q +write (UNIT=nout, IOSTAT=ios) a ! no fmt= +``` + +## Direct-access files + +This form of I/O is also known as random access or indexed I/O. Here, +all the records have the same length, and each record is identified by +an index number. It is possible to write, read, or re-write any +specified record without regard to position. + +```f90 +integer, parameter :: nunit = 2, length = 100 +real, dimension(length) :: a +real, dimension(length + 1:2*length) :: b +integer :: i, rec_length +: +inquire (IOLENGTH=rec_length) a +open (UNIT=nunit, ACCESS="direct", RECL=rec_length, STATUS="scratch", ACTION="readwrite") +: +! Write array b to direct-access file in record 14 +write (UNIT=nunit, REC=14) b +: +! Read the array back into array a +read (UNIT=nunit, REC=14) a + +do i = 1, length / 2 + a(i) = i +end do + +! Replace modified record +write (UNIT=nunit, REC=14) a +``` + +The file must be an external file and list-directed formatting and +non-advancing I/O are unavailable. diff --git a/source/learn/f95_features/expressions_and_assignments.md b/source/learn/f95_features/expressions_and_assignments.md new file mode 100644 index 000000000000..7e21e4185189 --- /dev/null +++ b/source/learn/f95_features/expressions_and_assignments.md @@ -0,0 +1,299 @@ +# Expressions and assignments + +## Scalar numeric + +The usual arithmetic operators are available `+, -, *, /, **` (given +here in increasing order of precedence). + +Parentheses are used to indicate the order of evaluation where +necessary: + +```f90 +a*b + c ! * first +a*(b + c) ! + first +``` + +The rules for *scalar numeric* expressions and assignments accommodate +the non-default kinds. Thus, the mixed-mode numeric expression and +assignment rules incorporate different kind type parameters in an +expected way: + +```f90 +real2 = integer0 + real1 +``` + +converts `integer0` to a real value of the same kind as `real1`; the +result is of same kind, and is converted to the kind of `real2` for +assignment. + +These functions are available for controlled +[rounding](https://en.wikipedia.org/wiki/Rounding) +of real numbers to integers: + +- `nint`: round to nearest integer, return integer result +- `anint`: round to nearest integer, return real result +- `int`: truncate (round towards zero), return integer result +- `aint`: truncate (round towards zero), return real result +- `ceiling`: smallest integral value not less than argument (round up) + (Fortran-90) +- `floor`: largest integral value not greater than argument (round + down) (Fortran-90) + +## Scalar relational operations + +For *scalar relational* operations of numeric types, there is a set of +built-in operators: + +`< <= == /= > >=` +`.lt. .le. .eq. .ne. .gt. .ge.` + +(the forms above are new to Fortran-90, and older equivalent forms are +given below them). Example expressions: + +```f90 +a < b .and. i /= j ! for numeric variables +flag = a == b ! for logical variable flags +``` + +### Scalar characters + +In the case of *scalar characters* and given + +```f90 +character(8) result +``` + +it is legal to write + +```f90 +result(3:5) = result(1:3) ! overlap allowed +result(3:3) = result(3:2) ! no assignment of null string +``` + +Concatenation is performed by the operator `//`. + +```f90 +result = 'abcde'//'123' +filename = result//'.dat' +``` + +## Derived-data types + +No built-in operations (except assignment, defined on component-by +component basis) exist between *derived data types* mutually or with +intrinsic types. The meaning of existing or user-specified operators can +be (re)defined though: + +```f90 +type string80 + integer length + character(80) value +end type string80 + +character:: char1, char2, char3 +type(string80):: str1, str2, str3 +``` + +we can write + +```f90 +str3 = str1//str2 ! must define operation +str3 = str1.concat.str2 ! must define operation +char3 = char2//char3 ! intrinsic operator only +str3 = char1 ! must define assignment +``` + +Notice the +["overloaded"](https://en.wikipedia.org/wiki/Operator_overloading) +use of the intrinsic symbol `//` and +the named operator, `.concat.` . A difference between the two cases is +that, for an intrinsic operator token, the usual precedence rules apply, +whereas for named operators, precedence is the highest as a unary +operator or the lowest as a binary one. In + +```f90 +vector3 = matrix * vector1 + vector2 +vector3 =(matrix .times. vector1) + vector2 +``` + +the two expressions are equivalent only if appropriate parentheses are +added as shown. In each case there must be defined, in a +[module](modules), +procedures defining the operator and assignment, and corresponding +operator-procedure association, as follows: + +```f90 +interface operator(//) ! Overloads the // operator as invoking string_concat procedure + module procedure string_concat +end interface +``` + +The string concatenation function is a more elaborated version of that +shown already in +[Basics](Basics). +Note that +in order to handle the error condition that arises when the two strings +together exceed the preset 80-character limit, it would be safer to use +a subroutine to perform the concatenation (in this case +operator-overloading would not be applicable.) + +```f90 +module string_type + implicit none + + type string80 + integer length + character(LEN=80) :: string_data + end type string80 + + interface assignment(=) + module procedure c_to_s_assign, s_to_c_assign + end interface + + interface operator(//) + module procedure string_concat + end interface + +contains + subroutine c_to_s_assign(s, c) + type(string80), intent(OUT) :: s + character(LEN=*), intent(IN) :: c + s%string_data = c + s%length = len(c) + end subroutine c_to_s_assign + + subroutine s_to_c_assign(c, s) + type(string80), intent(IN) :: s + character(LEN=*), intent(OUT) :: c + c = s%string_data(1:s%length) + end subroutine s_to_c_assign + + type(string80) function string_concat(s1, s2) + type(string80), intent(IN) :: s1, s2 + type(string80) :: s + integer :: n1, n2 + character(160) :: ctot + n1 = len_trim(s1%string_data) + n2 = len_trim(s2%string_data) + if (n1 + n2 <= 80) then + s%string_data = s1%string_data(1:n1)//s2%string_data(1:n2) + else ! This is an error condition which should be handled - for now just truncate + ctot = s1%string_data(1:n1)//s2%string_data(1:n2) + s%string_data = ctot(1:80) + end if + s%length = len_trim(s%string_data) + string_concat = s + end function string_concat +end module string_type + +program main + use string_type + type(string80) :: s1, s2, s3 + call c_to_s_assign(s1, 'My name is') + call c_to_s_assign(s2, ' Linus Torvalds') + s3 = s1//s2 + write (*, *) 'Result: ', s3%string_data + write (*, *) 'Length: ', s3%length +end program +``` + +Defined operators such as these are required for the expressions that +are allowed also in structure constructors (see +[Derived-data types](Derived-data_types): + +```f90 +str1 = string(2, char1//char2) ! structure constructor +``` + +## Arrays + +In the case of arrays then, as long as they are of the same shape +(conformable), operations and assignments are extended in an obvious +way, on an element-by-element basis. For example, given declarations of + +```f90 +real, dimension(10, 20) :: a, b, c +real, dimension(5) :: v, w +logical flag(10, 20) +``` + +it can be written: + +```f90 +a = b ! whole array assignment +c = a/b ! whole array division and assignment +c = 0. ! whole array assignment of scalar value +w = v + 1. ! whole array addition to scalar value +w = 5/v + a(1:5, 5) ! array division, and addition to section +flag = a==b ! whole array relational test and assignment +c(1:8, 5:10) = a(2:9, 5:10) + b(1:8, 15:20) ! array section addition and assignment +v(2:5) = v(1:4) ! overlapping section assignment +``` + +The order of expression evaluation is not specified in order to allow +for optimization on parallel and vector machines. Of course, any +operators for arrays of derived type must be defined. + +Some real intrinsic functions that are useful for numeric computations +are + +- `ceiling` +- `floor` +- `modulo` + (also integer) +- `exponent` +- `fraction` +- `nearest` +- `rrspacing` +- `spacing` +- `scale` +- `set_exponent` + +These are array valued for array arguments (elemental), like all +[FORTRAN 77](https://en.wikipedia.org/wiki/FORTRAN_77) +functions (except `len`): + +- `int` +- `real` +- `cmplx` +- `aint` +- `anint` +- `nint` +- `abs` +- `mod` +- `sign` +- `dim` +- `max` +- `min` + +Powers, logarithms, and trigonometric functions + +- `sqrt` +- `exp` +- `log` +- `log10` +- `sin` +- `cos` +- `tan` +- `asin` +- `acos` +- `atan` +- `atan2` +- `sinh` +- `cosh` +- `tanh` + +Complex numbers: + +- `aimag` +- `conjg` + +The following are for characters: + +- `lge` +- `lgt` +- `lle` +- `llt` +- `ichar` +- `char` +- `index` diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md index 4042cac3e531..679b623a8190 100644 --- a/source/learn/f95_features/f95_features.md +++ b/source/learn/f95_features/f95_features.md @@ -1,2317 +1,3 @@ - -## Language elements - -Fortran is case-insensitive. The convention of writing -Fortran keywords in upper case and all other names in lower case is -adopted in this article; except, by way of contrast, in the input/output -descriptions -(Data -transfer and -Operations on external files). - -### Basics - -The basic component of the Fortran language is its *character set*. Its -members are - -- the letters A ... Z and a ... z (which are equivalent outside a - character context) -- the numerals 0 ... 9 -- the underscore \_ -- the special characters - `= : + blank - * / ( ) [ ] , . $ ' ! " % & ; < > ?` - -Tokens that -have a syntactic meaning to the compiler are built from those -components. There are six classes of tokens: - -| Label | `123` | -|-----------|------------------------------------------------------| -| Constant | `123.456789_long` | -| Keyword | `ALLOCATABLE` | -| Operator | `.add.` | -| Name | `solve_equation` (up to 31 characters, including \_) | -| Separator | `/ ( ) (/ /) [ ] , = => : :: ; %` | - -From the tokens, statements are built. These can be coded using the -new free *source form* which does not require positioning in a rigid -column structure: - -```f90 -FUNCTION string_concat(s1, s2) ! This is a comment - TYPE (string), INTENT(IN) :: s1, s2 - TYPE (string) string_concat - string_concat%string_data = s1%string_data(1:s1%length) // & - s2%string_data(1:s2%length) ! This is a continuation - string_concat%length = s1%length + s2%length -END FUNCTION string_concat -``` - -Note the trailing comments and the trailing continuation mark. There may -be 39 continuation lines, and 132 characters per line. Blanks are -significant. Where a token or character constant is split across two -lines: - -```f90 - ... start_of& - &_name - ... 'a very long & - &string' -``` - -a leading `&` on the continued line is also required. - -### Intrinsic data types - -Fortran has five *intrinsic data types*: `INTEGER`, `REAL`, `COMPLEX`, -`LOGICAL` and `CHARACTER`. Each of those types can be additionally -characterized by a *kind*. Kind, basically, defines internal -representation of the type: for the three numeric types, it defines the -precision and range, and for the other two, the specifics of storage -representation. Thus, it is an abstract concept which models the limits -of data types' representation; it is expressed as a member of a set of -whole numbers (e.g. it may be {1, 2, 4, 8} for integers, denoting bytes -of storage), but those values are not specified by the Standard and not -portable. For every type, there is a *default kind*, which is used if no -kind is explicitly specified. For each intrinsic type, there is a -corresponding form of *literal constant*. The numeric types `INTEGER` -and `REAL` can only be signed (there is no concept of sign for type -`COMPLEX`). - -#### Literal constants and kinds - -##### INTEGER - -Integer literal constants of the default kind take the form - -```f90 -1 0 -999 32767 +10 -``` - -Kind can be defined as a named constant. If the desired range is -±10kind, the portable syntax for defining the appropriate -kind, `two_bytes` is - -```f90 -INTEGER, PARAMETER :: two_bytes = SELECTED_INT_KIND(4) -``` - -that allows subsequent definition of constants of the form - -```f90 --1234_two_bytes +1_two_bytes -``` - -Here, `two_bytes` is the kind type parameter; it can also be an explicit -default integer literal constant, like - -```f90 --1234_2 -``` - -but such use is non-portable. - -The KIND function supplies the value of a kind type parameter: - -```f90 -KIND(1) KIND(1_two_bytes) -``` - -and the `RANGE` function supplies the actual decimal range (so the user -must make the actual mapping to bytes): - -```f90 -RANGE(1_two_bytes) -``` - -Also, in DATA -(initialization) statements, binary (B), octal (O) and hexadecimal -(Z) constants may be used (often informally referred to as "BOZ -constants"): - -```f90 -B'01010101' O'01234567' Z'10fa' -``` - -##### REAL - -There are at least two real kindsthe default and one with greater -precision (this replaces - -```f90 -DOUBLE PRECISION -``` - -). - -```f90 -SELECTED_REAL_KIND -``` - -functions returns the kind number for desired range and precision; for -at least 9 decimal digits of precision and a range of 10−99 -to 1099, it can be specified as: - -```f90 -INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(9, 99) -``` - -and literals subsequently specified as - -```f90 -1.7_long -``` - -Also, there are the intrinsic functions - -```f90 -KIND(1.7_long) PRECISION(1.7_long) RANGE(1.7_long) -``` - -that give in turn the kind type value, the actual precision (here at -least 9), and the actual range (here at least 99). - -##### COMPLEX - -`COMPLEX` data type is built of two integer or real components: - -```f90 -(1, 3.7_long) -``` - -##### LOGICAL - -There are only two basic values of logical constants: `.TRUE.` and -`.FALSE.`. Here, there may also be different kinds. Logicals don't have -their own kind inquiry functions, but use the kinds specified for -`INTEGER`s; default kind of `LOGICAL` is the same as of INTEGER. - -```f90 -.FALSE. .true._one_byte -``` - -and the `KIND` function operates as expected: - -```f90 -KIND(.TRUE.) -``` - -##### CHARACTER - -The forms of literal constants for `CHARACTER` data type are - -```f90 -'A string' "Another" 'A "quote"' ''''''' -``` - -(the last being an empty string). Different kinds are allowed (for -example, to distinguish -ASCII and -UNICODE strings), -but not widely supported by compilers. Again, the kind value is given by -the `KIND` function: - -```f90 -KIND('ASCII') -``` - -#### Number model and intrinsic functions - -The numeric types are based on number models with associated inquiry -functions (whose values are independent of the values of their -arguments; arguments are used only to provide kind). These functions are -important for portable numerical software: - -| | | -|------------------|------------------------------------------| -| `DIGITS(X)` | Number of significant digits | -| `EPSILON(X)` | Almost negligible compared to one (real) | -| `HUGE(X)` | Largest number | -| `MAXEXPONENT(X)` | Maximum model exponent (real) | -| `MINEXPONENT(X)` | Minimum model exponent (real) | -| `PRECISION(X)` | Decimal precision (real, complex) | -| `RADIX(X)` | Base of the model | -| `RANGE(X)` | Decimal exponent range | -| `TINY(X)` | Smallest positive number (real) | - -### Scalar variables - -Scalar variables corresponding to the five intrinsic -types are specified as follows: - -```f90 -INTEGER(KIND=2) :: i -REAL(KIND=long) :: a -COMPLEX :: current -LOGICAL :: Pravda -CHARACTER(LEN=20) :: word -CHARACTER(LEN=2, KIND=Kanji) :: kanji_word -``` - -where the optional `KIND` parameter specifies a non-default kind, and -the `::` notation delimits the type and attributes from variable name(s) -and their optional initial values, allowing full variable specification -and initialization to be typed in one statement (in previous standards, -attributes and initializers had to be declared in several statements). -While it is not required in above examples (as there are no additional -attributes and initialization), most Fortran-90 programmers acquire the -habit to use it everywhere. - -```f90 -LEN= -``` - -specifier is applicable only to `CHARACTER`s and specifies the string -length (replacing the older `*len` form). The explicit `KIND=` and -`LEN=` specifiers are optional: - -```f90 -CHARACTER(2, Kanji) :: kanji_word -``` - -works just as well. - -There are some other interesting character features. Just as a substring -as in - -```f90 -CHARACTER(80) :: line -... = line(i:i) ! substring -``` - -was previously possible, so now is the substring - -```f90 -'0123456789'(i:i) -``` - -Also, zero-length strings are allowed: - -```f90 -line(i:i-1) ! zero-length string -``` - -Finally, there is a set of intrinsic character functions, examples being - -| | | -|------------|------------------------------| -| `ACHAR` | `IACHAR` (for ASCII set) | -| `ADJUSTL` | `ADJUSTR` | -| `LEN_TRIM` | `INDEX(s1, s2, BACK=.TRUE.)` | -| `REPEAT` | `SCAN`(for one of a set) | -| `TRIM` | `VERIFY`(for all of a set) | - -### Derived data types - -For derived data types, the form of the type must be defined first: - -```f90 -TYPE person - CHARACTER(10) name - REAL age -END TYPE person -``` - -and then, variables of that type can be defined: - -```f90 -TYPE(person) you, me -``` - -To select components of a derived type, `%` qualifier is used: - -```f90 -you%age -``` - -Literal constants of derived types have the form -*`TypeName(1stComponentLiteral, 2ndComponentLiteral, ...)`*: - -```f90 -you = person('Smith', 23.5) -``` - -which is known as a *structure constructor*. Definitions may refer to a -previously defined type: - -```f90 -TYPE point - REAL x, y -END TYPE point -TYPE triangle - TYPE(point) a, b, c -END TYPE triangle -``` - -and for a variable of type triangle, as in - -```f90 -TYPE(triangle) t -``` - -each component of type `point` is accessed as - -```f90 -t%a t%b t%c -``` - -which, in turn, have ultimate components of type real: - -```f90 -t%a%x t%a%y t%b%x etc. -``` - -(Note that the `%` qualifier was chosen rather than dot (`.`) because of -potential ambiguity with operator notation, like `.OR.`). - -### Implicit and explicit typing - -Unless specified otherwise, all variables starting with letters I, J, K, -L, M and N are default `INTEGER`s, and all others are default `REAL`; -other data types must be explicitly declared. This is known as *implicit -typing* and is a heritage of early FORTRAN days. Those defaults can be -overridden by *`IMPLICIT TypeName (CharacterRange)`* statements, like: - -```f90 -IMPLICIT COMPLEX(Z) -IMPLICIT CHARACTER(A-B) -IMPLICIT REAL(C-H,N-Y) -``` - -However, it is a good practice to explicitly type all variables, and -this can be forced by inserting the statement - -```f90 -IMPLICIT NONE -``` - -at the beginning of each program unit. - -### Arrays - -Arrays are considered to be variables in their own right. Every array is -characterized by its -type, -rank, and *shape* (which defines the extents of each -dimension). Bounds of each dimension are by default 1 and *size*, but -arbitrary bounds can be explicitly specified. `DIMENSION` keyword is -optional and considered an attribute; if omitted, the array shape must -be specified after array-variable name. For example, - -```f90 -REAL:: a(10) -INTEGER, DIMENSION(0:100, -50:50) :: map -``` - -declares two arrays, rank-1 and rank-2, whose elements are in -column-major order. Elements are, for -example, - -```f90 -a(1) a(i*j) -``` - -and are scalars. The subscripts may be any scalar integer expression. - -*Sections* are parts of the array variables, and are arrays themselves: - -```f90 -a(i:j) ! rank one -map(i:j, k:l:m) ! rank two -a(map(i, k:l)) ! vector subscript -a(3:2) ! zero length -``` - -Whole arrays and array sections are array-valued objects. Array-valued -constants (constructors) are available, enclosed in `(/ ... /)`: - -```f90 -(/ 1, 2, 3, 4 /) -(/ ( (/ 1, 2, 3 /), i = 1, 4) /) -(/ (i, i = 1, 9, 2) /) -(/ (0, i = 1, 100) /) -(/ (0.1*i, i = 1, 10) /) -``` - -making use of an implied-DO loop notation. Fortran 2003 allows the use -of brackets: `[1, 2, 3, 4]` and `[([1,2,3], i=1,4)]` instead of the -first two examples above, and many compilers support this now. A derived -data type may, of course, contain array components: - -```f90 -TYPE triplet - REAL, DIMENSION(3) :: vertex -END TYPE triplet -TYPE(triplet), DIMENSION(4) :: t -``` - -so that - -- ```f90 - t(2) - ``` - - is a scalar (a structure) - -- ```f90 - t(2)%vertex - ``` - - is an array component of a scalar - -### Data initialization - -Variables can be given initial values as specified in a specification -statement: - -```f90 -REAL, DIMENSION(3) :: a = (/ 0.1, 0.2, 0.3 /) -``` - -and a default initial value can be given to the component of a derived -data type: - -```f90 -TYPE triplet - REAL, DIMENSION(3) :: vertex = 0.0 -END TYPE triplet -``` - -When local variables are initialized within a procedure they implicitly -acquire the SAVE attribute: - -```f90 -REAL, DIMENSION(3) :: point = (/ 0.0, 1.0, -1.0 /) -``` - -This declaration is equivalent to - -```f90 -REAL, DIMENSION(3), SAVE :: point = (/ 0.0, 1.0, -1.0 /) -``` - -for local variables within a subroutine or function. The SAVE attribute -causes local variables to retain their value after a procedure call and -then to initialize the variable to the saved value upon returning to the -procedure. - -#### PARAMETER attribute - -A named constant can be specified directly by adding the `PARAMETER` -attribute and the constant values to a type statement: - -```f90 -REAL, DIMENSION(3), PARAMETER :: field = (/ 0., 1., 2. /) -TYPE(triplet), PARAMETER :: t = triplet( (/ 0., 0., 0. /) ) -``` - -#### DATA statement - -The `DATA` statement can be used for scalars and also for arrays and -variables of derived type. It is also the only way to initialise just -parts of such objects, as well as to initialise to binary, octal or -hexadecimal values: - -```f90 -TYPE(triplet) :: t1, t2 -DATA t1/triplet( (/ 0., 1., 2. /) )/, t2%vertex(1)/123./ -DATA array(1:64) / 64*0/ -DATA i, j, k/ B'01010101', O'77', Z'ff'/ -``` - -#### Initialization expressions - -The values used in `DATA` and `PARAMETER` statements, or with these -attributes, are constant expressions that may include references to: -array and structure constructors, elemental intrinsic functions with -integer or character arguments and results, and the six transformational -functions `REPEAT, SELECTED_INT_KIND, TRIM, SELECTED_REAL_KIND, RESHAPE` -and `TRANSFER` (see Intrinsic procedures): - -```f90 -INTEGER, PARAMETER :: long = SELECTED_REAL_KIND(12), & - array(3) = (/ 1, 2, 3 /) -``` - -### Specification expressions - -It is possible to specify details of variables using any non-constant, -scalar, integer expression that may also include inquiry function -references: - -```f90 -SUBROUTINE s(b, m, c) - USE mod ! contains a - REAL, DIMENSION(:, :) :: b - REAL, DIMENSION(UBOUND(b, 1) + 5) :: x - INTEGER :: m - CHARACTER(LEN=*) :: c - CHARACTER(LEN= m + LEN(c)) :: cc - REAL (SELECTED_REAL_KIND(2*PRECISION(a))) :: z -``` - -## Expressions and assignments - -### Scalar numeric - -The usual arithmetic operators are available `+, -, *, /, **` (given -here in increasing order of precedence). - -Parentheses are used to indicate the order of evaluation where -necessary: - -```f90 -a*b + c ! * first -a*(b + c) ! + first -``` - -The rules for *scalar numeric* expressions and assignments accommodate -the non-default kinds. Thus, the mixed-mode numeric expression and -assignment rules incorporate different kind type parameters in an -expected way: - -```f90 -real2 = integer0 + real1 -``` - -converts `integer0` to a real value of the same kind as `real1`; the -result is of same kind, and is converted to the kind of `real2` for -assignment. - -These functions are available for controlled -rounding of -real numbers to integers: - -- `NINT`: round to nearest integer, return integer result -- `ANINT`: round to nearest integer, return real result -- `INT`: truncate (round towards zero), return integer result -- `AINT`: truncate (round towards zero), return real result -- `CEILING`: smallest integral value not less than argument (round up) - (Fortran-90) -- `FLOOR`: largest integral value not greater than argument (round - down) (Fortran-90) - -### Scalar relational operations - -For *scalar relational* operations of numeric types, there is a set of -built-in operators: - -`< <= == /= > >=` -`.LT. .LE. .EQ. .NE. .GT. .GE.` - -(the forms above are new to Fortran-90, and older equivalent forms are -given below them). Example expressions: - -```f90 -a < b .AND. i /= j ! for numeric variables -flag = a == b ! for logical variable flags -``` - -### Scalar characters - -In the case of *scalar characters* and given - -```f90 -CHARACTER(8) result -``` - -it is legal to write - -```f90 -result(3:5) = result(1:3) ! overlap allowed -result(3:3) = result(3:2) ! no assignment of null string -``` - -Concatenation is performed by the operator '//'. - -```f90 -result = 'abcde'//'123' -filename = result//'.dat' -``` - -### Derived-data types - -No built-in operations (except assignment, defined on component-by -component basis) exist between *derived data types* mutually or with -intrinsic types. The meaning of existing or user-specified operators can -be (re)defined though: - -```f90 -TYPE string80 - INTEGER length - CHARACTER(80) value -END TYPE string80 -CHARACTER:: char1, char2, char3 -TYPE(string80):: str1, str2, str3 -``` - -we can write - -```f90 -str3 = str1//str2 ! must define operation -str3 = str1.concat.str2 ! must define operation -char3 = char2//char3 ! intrinsic operator only -str3 = char1 ! must define assignment -``` - -Notice the "overloaded" use of the intrinsic symbol `//` and -the named operator, `.concat.` . A difference between the two cases is -that, for an intrinsic operator token, the usual precedence rules apply, -whereas for named operators, precedence is the highest as a unary -operator or the lowest as a binary one. In - -```f90 -vector3 = matrix * vector1 + vector2 -vector3 =(matrix .times. vector1) + vector2 -``` - -the two expressions are equivalent only if appropriate parentheses are -added as shown. In each case there must be defined, in a -module, -procedures defining the operator and assignment, and corresponding -operator-procedure association, as follows: - -```f90 -INTERFACE OPERATOR(//) !Overloads the // operator as invoking string_concat procedure - MODULE PROCEDURE string_concat -END INTERFACE -``` - -The string concatenation function is a more elaborated version of that -shown already in -Basics. Note that -in order to handle the error condition that arises when the two strings -together exceed the preset 80-character limit, it would be safer to use -a subroutine to perform the concatenation (in this case -operator-overloading would not be applicable.) - -```f90 -MODULE string_type - IMPLICIT NONE - TYPE string80 - INTEGER length - CHARACTER(LEN=80) :: string_data - END TYPE string80 - INTERFACE ASSIGNMENT(=) - MODULE PROCEDURE c_to_s_assign, s_to_c_assign - END INTERFACE - INTERFACE OPERATOR(//) - MODULE PROCEDURE string_concat - END INTERFACE -CONTAINS - SUBROUTINE c_to_s_assign(s, c) - TYPE (string80), INTENT(OUT) :: s - CHARACTER(LEN=*), INTENT(IN) :: c - s%string_data = c - s%length = LEN(c) - END SUBROUTINE c_to_s_assign - SUBROUTINE s_to_c_assign(c, s) - TYPE (string80), INTENT(IN) :: s - CHARACTER(LEN=*), INTENT(OUT) :: c - c = s%string_data(1:s%length) - END SUBROUTINE s_to_c_assign - TYPE(string80) FUNCTION string_concat(s1, s2) - TYPE(string80), INTENT(IN) :: s1, s2 - TYPE(string80) :: s - INTEGER :: n1, n2 - CHARACTER(160) :: ctot - n1 = LEN_TRIM(s1%string_data) - n2 = LEN_TRIM(s2%string_data) - IF (n1+n2 <= 80) then - s%string_data = s1%string_data(1:n1)//s2%string_data(1:n2) - ELSE ! This is an error condition which should be handled - for now just truncate - ctot = s1%string_data(1:n1)//s2%string_data(1:n2) - s%string_data = ctot(1:80) - END IF - s%length = LEN_TRIM(s%string_data) - string_concat = s - END FUNCTION string_concat -END MODULE string_type - -PROGRAM main - USE string_type - TYPE(string80) :: s1, s2, s3 - CALL c_to_s_assign(s1,'My name is') - CALL c_to_s_assign(s2,' Linus Torvalds') - s3 = s1//s2 - WRITE(*,*) 'Result: ',s3%string_data - WRITE(*,*) 'Length: ',s3%length -END PROGRAM -``` - -Defined operators such as these are required for the expressions that -are allowed also in structure constructors (see -Derived-data types): - -```f90 -str1 = string(2, char1//char2) ! structure constructor -``` - -### Arrays - -In the case of arrays then, as long as they are of the same shape -(conformable), operations and assignments are extended in an obvious -way, on an element-by-element basis. For example, given declarations of - -```f90 -REAL, DIMENSION(10, 20) :: a, b, c -REAL, DIMENSION(5) :: v, w -LOGICAL flag(10, 20) -``` - -it can be written: - -```f90 -a = b ! whole array assignment -c = a/b ! whole array division and assignment -c = 0. ! whole array assignment of scalar value -w = v + 1. ! whole array addition to scalar value -w = 5/v + a(1:5, 5) ! array division, and addition to section -flag = a==b ! whole array relational test and assignment -c(1:8, 5:10) = a(2:9, 5:10) + b(1:8, 15:20) ! array section addition and assignment -v(2:5) = v(1:4) ! overlapping section assignment -``` - -The order of expression evaluation is not specified in order to allow -for optimization on parallel and vector machines. Of course, any -operators for arrays of derived type must be defined. - -Some real intrinsic functions that are useful for numeric computations -are - -- ```f90 - CEILING - ``` - -- ```f90 - FLOOR - ``` - -- ```f90 - MODULO - ``` - - (also integer) - -- ```f90 - EXPONENT - ``` - -- ```f90 - FRACTION - ``` - -- ```f90 - NEAREST - ``` - -- ```f90 - RRSPACING - ``` - -- ```f90 - SPACING - ``` - -- ```f90 - SCALE - ``` - -- ```f90 - SET_EXPONENT - ``` - -These are array valued for array arguments (elemental), like all -FORTRAN 77 -functions (except LEN): - -- ```f90 - INT - ``` - -- ```f90 - REAL - ``` - -- ```f90 - CMPLX - ``` - -- ```f90 - AINT - ``` - -- ```f90 - ANINT - ``` - -- ```f90 - NINT - ``` - -- ```f90 - ABS - ``` - -- ```f90 - MOD - ``` - -- ```f90 - SIGN - ``` - -- ```f90 - DIM - ``` - -- ```f90 - MAX - ``` - -- ```f90 - MIN - ``` - -Powers, logarithms, and trigonometric functions - -- ```f90 - SQRT - ``` - -- ```f90 - EXP - ``` - -- ```f90 - LOG - ``` - -- ```f90 - LOG10 - ``` - -- ```f90 - SIN - ``` - -- ```f90 - COS - ``` - -- ```f90 - TAN - ``` - -- ```f90 - ASIN - ``` - -- ```f90 - ACOS - ``` - -- ```f90 - ATAN - ``` - -- ```f90 - ATAN2 - ``` - -- ```f90 - SINH - ``` - -- ```f90 - COSH - ``` - -- ```f90 - TANH - ``` - -Complex numbers: - -- ```f90 - AIMAG - ``` - -- ```f90 - CONJG - ``` - -The following are for characters: - -- ```f90 - LGE - ``` - -- ```f90 - LGT - ``` - -- ```f90 - LLE - ``` - -- ```f90 - LLT - ``` - -- ```f90 - ICHAR - ``` - -- ```f90 - CHAR - ``` - -- ```f90 - INDEX - ``` - -## Control statements - -### Branching and conditions - -The simple `GO TO` *label* exists, but is usually avoided in most cases, -a more specific branching construct will accomplish the same logic with -more clarity. - -The simple conditional test is the `IF` statement: - -```f90 -IF (a > b) x = y -``` - -A full-blown `IF` construct is illustrated by - -```f90 -IF (i < 0) THEN - IF (j < 0) THEN - x = 0. - ELSE - z = 0. - END IF -ELSE IF (k < 0) THEN - z = 1. -ELSE - x = 1. -END IF -``` - -### CASE construct - -The `CASE` construct is a replacement for the computed `GOTO`, but is -better structured and does not require the use of statement labels: - -```f90 -SELECT CASE (number) ! number of type integer -CASE (:-1) ! all values below 0 - n_sign = -1 -CASE (0) ! only 0 - n_sign = 0 -CASE (1:) ! all values above 0 - n_sign = 1 -END SELECT -``` - -Each `CASE` selector list may contain a list and/or range of integers, -character or logical constants, whose values may not overlap within or -between selectors: - -```f90 -CASE (1, 2, 7, 10:17, 23) -``` - -A default is available: - -```f90 -CASE DEFAULT -``` - -There is only one evaluation, and only one match. - -### DO construct - -A simplified but sufficient form of the `DO` construct is illustrated by - -```f90 -outer: DO -inner: DO i = j, k, l ! from j to k in steps of l (l is optional) - : - IF (...) CYCLE - : - IF (...) EXIT outer - : - END DO inner - END DO outer -``` - -where we note that loops may be optionally named so that any EXIT or -CYCLE statement may specify which loop is meant. - -Many, but not all, simple loops can be replaced by array expressions and -assignments, or by new intrinsic functions. For instance - -```f90 -tot = 0. -DO i = m, n - tot = tot + a(i) -END DO -``` - -becomes simply - -```f90 -tot = SUM( a(m:n) ) -``` - -## Program units and procedures - -### Definitions - -In order to discuss this topic we need some definitions. In logical -terms, an executable program consists of one *main program* and zero or -more *subprograms* (or *procedures*) - these do something. Subprograms -are either *functions*or *subroutines*, which are either *external, -internal* or *module* subroutines. (External subroutines are what we -knew from FORTRAN 77.) - -From an organizational point of view, however, a complete program -consists of *program units*. These are either *main programs, external -subprograms* or *modules* and can be separately compiled. - -An example of a main (and complete) program is - -```f90 -PROGRAM test - PRINT *, 'Hello world!' -END PROGRAM test -``` - -An example of a main program and an external subprogram, forming an -executable program, is - -```f90 -PROGRAM test - CALL print_message -END PROGRAM test -SUBROUTINE print_message - PRINT *, 'Hello world!' -END SUBROUTINE print_message -``` - -The form of a function is - -```f90 -FUNCTION name(arg1, arg2) ! zero or more arguments - : - name = ... - : -END FUNCTION name -``` - -The form of reference of a function is - -```f90 -x = name(a, b) -``` - -### Internal procedures - -An internal subprogram is one *contained* in another (at a maximum of -one level of nesting) and provides a replacement for the statement -function: - -```f90 -SUBROUTINE outer - REAL x, y - : -CONTAINS - SUBROUTINE inner - REAL y - y = x + 1. - : - END SUBROUTINE inner ! SUBROUTINE mandatory -END SUBROUTINE outer -``` - -We say that `outer` is the *host* of `inner`, and that `inner` obtains -access to entities in `outer` by *host association* (e.g. to `x`), -whereas `y` is a *local* variable to `inner`. - -The *scope* of a named entity is a *scoping unit*, here `outer` less -`inner`, and `inner`. - -The names of program units and external procedures are *global*, and the -names of implied-DO variables have a scope of the statement that -contains them. - -### Modules - -Modules are used to package - -- global data (replaces COMMON and BLOCK DATA from Fortran 77); -- type definitions (themselves a scoping unit); -- subprograms (which among other things replaces the use of ENTRY from - Fortran 77); -- interface blocks (another scoping unit, see - Interface blocks); -- namelist groups (see any textbook). - -An example of a module containing a type definition, interface block and -function subprogram is - -```f90 -MODULE interval_arithmetic - TYPE interval - REAL lower, upper - END TYPE interval - INTERFACE OPERATOR(+) - MODULE PROCEDURE add_intervals - END INTERFACE - : -CONTAINS - FUNCTION add_intervals(a,b) - TYPE(interval), INTENT(IN) :: a, b - TYPE(interval) add_intervals - add_intervals%lower = a%lower + b%lower - add_intervals%upper = a%upper + b%upper - END FUNCTION add_intervals ! FUNCTION mandatory - : -END MODULE interval_arithmetic -``` - -and the simple statement - -```f90 - -USE interval_arithmetic -``` - -provides *use association* to all the module's entities. Module -subprograms may, in turn, contain internal subprograms. - -### Controlling accessibility - -The `PUBLIC` and `PRIVATE` attributes are used in specifications in -modules to limit the scope of entities. The attribute form is - -```f90 -REAL, PUBLIC :: x, y, z ! default -INTEGER, PRIVATE :: u, v, w -``` - -and the statement form is - -```f90 -PUBLIC :: x, y, z, OPERATOR(.add.) -PRIVATE :: u, v, w, ASSIGNMENT(=), OPERATOR(*) -``` - -The statement form has to be used to limit access to operators, and can -also be used to change the overall default: - -```f90 -PRIVATE ! sets default for module -PUBLIC :: only_this -``` - -For derived types there are three possibilities: the type and its -components are all PUBLIC, the type is PUBLIC and its components PRIVATE -(the type only is visible and one can change its details easily), or all -of it is PRIVATE (for internal use in the module only): - -```f90 -MODULE mine - PRIVATE - TYPE, PUBLIC :: list - REAL x, y - TYPE(list), POINTER :: next - END TYPE list - TYPE(list) :: tree - : -END MODULE mine -``` - -The `USE` statement's purpose is to gain access to entities in a module. -It has options to resolve name clashes if an imported name is the same -as a local one: - -```f90 -USE mine, local_list => list -``` - -or to restrict the used entities to a specified set: - -```f90 -USE mine, ONLY : list -``` - -These may be combined: - -```f90 -USE mine, ONLY : local_list => list -``` - -### Arguments - -We may specify the intent of dummy arguments: - -```f90 -SUBROUTINE shuffle (ncards, cards) - INTEGER, INTENT(IN) :: ncards - INTEGER, INTENT(OUT), DIMENSION(ncards) :: cards -``` - -Also, INOUT is possible: here the actual argument must be a variable -(unlike the default case where it may be a constant). - -Arguments may be optional: - -```f90 -SUBROUTINE mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstart) - REAL, OPTIONAL, DIMENSION :: upper, lower - : - IF (PRESENT(lower)) THEN ! test for presence of actual argument - : -``` - -allows us to call `mincon` by - -```f90 -CALL mincon (n, f, x, upper) -``` - -Arguments may be keyword rather than positional (which come first): - -```f90 -CALL mincon(n, f, x, equalities=0, xstart=x0) -``` - -Optional and keyword arguments are handled by explicit interfaces, that -is with internal or module procedures or with interface blocks. - -### Interface blocks - -Any reference to an internal or module subprogram is through an -interface that is 'explicit' (that is, the compiler can see all the -details). A reference to an external (or dummy) procedure is usually -'implicit' (the compiler assumes the details). However, we can provide -an explicit interface in this case too. It is a copy of the header, -specifications and END statement of the procedure concerned, either -placed in a module or inserted directly: - -```f90 -REAL FUNCTION minimum(a, b, func) - ! returns the minimum value of the function func(x) - ! in the interval (a,b) - REAL, INTENT(in) :: a, b - INTERFACE - REAL FUNCTION func(x) - REAL, INTENT(IN) :: x - END FUNCTION func - END INTERFACE - REAL f,x - : - f = func(x) ! invocation of the user function. - : -END FUNCTION minimum -``` - -An explicit interface is obligatory for - -- optional and keyword arguments; -- POINTER and TARGET arguments (see - Pointers); -- POINTER function result; -- new-style array arguments and array functions - (Array - handling). - -It allows full checks at compile time between actual and dummy -arguments. - -**In general, the best way to ensure that a procedure interface is -explicit is either to place the procedure concerned in a module or to -use it as an internal procedure.** - -### Overloading and generic interfaces - -Interface blocks provide the mechanism by which we are able to define -generic names for specific procedures: - -```f90 -INTERFACE gamma ! generic name - FUNCTION sgamma(X) ! specific name - REAL (SELECTED_REAL_KIND( 6)) sgamma, x - END - FUNCTION dgamma(X) ! specific name - REAL (SELECTED_REAL_KIND(12)) dgamma, x - END -END INTERFACE -``` - -where a given set of specific names corresponding to a generic name must -all be of functions or all of subroutines. If this interface is within a -module, then it is simply - -```f90 -INTERFACE gamma - MODULE PROCEDURE sgamma, dgamma -END INTERFACE -``` - -We can use existing names, e.g. SIN, and the compiler sorts out the -correct association. - -We have already seen the use of interface blocks for defined operators -and assignment (see -Modules). - -### Recursion - -Indirect recursion is useful for multi-dimensional integration. For - -```f90 -volume = integrate(fy, ybounds) -``` - -We might have - -```f90 -RECURSIVE FUNCTION integrate(f, bounds) - ! Integrate f(x) from bounds(1) to bounds(2) - REAL integrate - INTERFACE - FUNCTION f(x) - REAL f, x - END FUNCTION f - END INTERFACE - REAL, DIMENSION(2), INTENT(IN) :: bounds - : -END FUNCTION integrate -``` - -and to integrate *f(x, y)* over a rectangle: - -```f90 -FUNCTION fy(y) - USE func ! module func contains function f - REAL fy, y - yval = y - fy = integrate(f, xbounds) -END -``` - -Direct recursion is when a procedure calls itself, as in - -```f90 -RECURSIVE FUNCTION factorial(n) RESULT(res) - INTEGER res, n - IF(n.EQ.0) THEN - res = 1 - ELSE - res = n*factorial(n-1) - END IF -END -``` - -Here, we note the `RESULT` clause and termination test. - -### Pure procedures - -This is a feature for parallel computing. - -In the FORALL statement and -construct, any side effects in a function can impede optimization on -a parallel processor the order of execution of the assignments could -affect the results. To control this situation, we add the `PURE` keyword -to the `SUBROUTINE` or `FUNCTION` statementan assertion that the -procedure (expressed simply): - -- alters no global variable, -- performs no I/O, -- has no saved variables (variables with the `SAVE` attribute that - retains values between invocations), and -- for functions, does not alter any of its arguments. - -A compiler can check that this is the case, as in - -```f90 -PURE FUNCTION calculate (x) -``` - -All the intrinsic functions are pure. - -## Array handling - -Array handling is included in Fortran for two main reasons: - -- the notational convenience it provides, bringing the code closer to - the underlying mathematical form; -- for the additional optimization opportunities it gives compilers - (although there are plenty of opportunities for degrading - optimization too!). - -At the same time, major extensions of the functionality in this area -have been added. We have already met whole arrays above -#Arrays 1 and -here -#Arrays 2 - -now we develop the theme. - -### Zero-sized arrays - -A zero-sized array is handled by Fortran as a legitimate object, without -special coding by the programmer. Thus, in - -```f90 -DO i = 1,n - x(i) = b(i) / a(i, i) - b(i+1:n) = b(i+1:n) - a(i+1:n, i) * x(i) -END DO -``` - -no special code is required for the final iteration where `i = n`. We -note that a zero-sized array is regarded as being defined; however, an -array of shape (0,2) is not conformable with one of shape (0,3), whereas - -```f90 -x(1:0) = 3 -``` - -is a valid 'do nothing' statement. - -### Assumed-shape arrays - -These are an extension and replacement for assumed-size arrays. Given an -actual argument like: - -```f90 -REAL, DIMENSION(0:10, 0:20) :: a - : -CALL sub(a) -``` - -the corresponding dummy argument specification defines only the type and -rank of the array, not its shape. This information has to be made -available by an explicit interface, often using an interface block (see -Interface blocks). Thus we write just - -```f90 -SUBROUTINE sub(da) - REAL, DIMENSION(:, :) :: da -``` - -and this is as if `da` were dimensioned (11,21). However, we can specify -any lower bound and the array maps accordingly. - -```f90 -REAL, DIMENSION(0:, 0:) :: da -``` - -The shape, not bounds, is passed, where the default lower bound is 1 and -the default upper bound is the corresponding extent. - -### Automatic arrays - -A partial replacement for the uses to which `EQUIVALENCE` was put is -provided by this facility, useful for local, temporary arrays, as in - -```f90 -SUBROUTINE swap(a, b) - REAL, DIMENSION(:) :: a, b - REAL, DIMENSION(SIZE(a)) :: work - work = a - a = b - b = work -END SUBROUTINE swap -``` - -The actual storage is typically maintained on a stack. - -### ALLOCATABLE and ALLOCATE - -Fortran provides dynamic allocation of storage; it relies on a heap -storage mechanism (and replaces another use of `EQUIVALENCE`). An -example for establishing a work array for a whole program is - -```f90 -MODULE work_array - INTEGER n - REAL, DIMENSION(:,:,:), ALLOCATABLE :: work -END MODULE -PROGRAM main - USE work_array - READ (input, *) n - ALLOCATE(work(n, 2*n, 3*n), STAT=status) - : - DEALLOCATE (work) -``` - -The work array can be propagated through the whole program via a `USE` -statement in each program unit. We may specify an explicit lower bound -and allocate several entities in one statement. To free dead storage we -write, for instance, - -```f90 -DEALLOCATE(a, b) -``` - -Deallocation of arrays is automatic when they go out of scope. - -### Elemental operations, assignments and procedures - -We have already met whole array assignments and operations: - -```f90 -REAL, DIMENSION(10) :: a, b -a = 0. ! scalar broadcast; elemental assignment -b = SQRT(a) ! intrinsic function result as array object -``` - -In the second assignment, an intrinsic function returns an array-valued -result for an array-valued argument. We can write array-valued functions -ourselves (they require an explicit interface): - -```f90 -PROGRAM test - REAL, DIMENSION(3) :: a = (/ 1., 2., 3./), & - b = (/ 2., 2., 2. /), r - r = f(a, b) - PRINT *, r -CONTAINS - FUNCTION f(c, d) - REAL, DIMENSION(:) :: c, d - REAL, DIMENSION(SIZE(c)) :: f - f = c*d ! (or some more useful function of c and d) - END FUNCTION f -END PROGRAM test -``` - -Elemental procedures are specified with scalar dummy arguments that may -be called with array actual arguments. In the case of a function, the -shape of the result is the shape of the array arguments. - -Most intrinsic functions are elemental and Fortran 95 extends this -feature to non-intrinsic procedures, thus providing the effect of -writing, in Fortran 90, 22 different versions, for ranks 0-0, 0-1, 1-0, -1-1, 0-2, 2-0, 2-2, ... 7-7, and is further an aid to optimization on -parallel processors. An elemental procedure must be pure. - -```f90 -ELEMENTAL SUBROUTINE swap(a, b) - REAL, INTENT(INOUT) :: a, b - REAL :: work - work = a - a = b - b = work -END SUBROUTINE swap -``` - -The dummy arguments cannot be used in specification expressions (see -above) except as arguments to certain intrinsic -functions (`BIT_SIZE`, `KIND`, `LEN`, and the numeric inquiry ones, (see -below). - -### WHERE - -Often, we need to mask an assignment. This we can do using the `WHERE`, -either as a statement: - -```f90 -WHERE (a /= 0.0) a = 1.0/a ! avoid division by 0 -``` - -(note: the test is element-by-element, not on whole array), or as a -construct: - -```f90 -WHERE (a /= 0.0) - a = 1.0/a - b = a ! all arrays same shape -END WHERE -``` - -or - -```f90 -WHERE (a /= 0.0) - a = 1.0/a -ELSEWHERE - a = HUGE(a) -END WHERE -``` - -Further: - -- it is permitted to mask not only the `WHERE` statement of the - `WHERE` construct, but also any `ELSEWHERE` statement that it - contains; -- a `WHERE` construct may contain any number of masked `ELSEWHERE` - statements but at most one `ELSEWHERE` statement without a mask, and - that must be the final one; -- `WHERE` constructs may be nested within one another, just `FORALL` - constructs; -- a `WHERE` assignment statement is permitted to be a defined - assignment, provided that it is elemental; -- a `WHERE` construct may be named in the same way as other - constructs. - -### The FORALL statement and construct - -When a `DO` construct is executed, each successive iteration is -performed in order and one after the otheran impediment to optimization -on a parallel processor. - -```f90 -FORALL(i = 1:n) a(i, i) = x(i) -``` - -where the individual assignments may be carried out in any order, and -even simultaneously. The `FORALL` may be considered to be an array -assignment expressed with the help of indices. - -```f90 -FORALL(i=1:n, j=1:n, y(i,j)/=0.) x(j,i) = 1.0/y(i,j) -``` - -with masking condition. - -The `FORALL` construct allows several assignment statements to be -executed in order. - -```f90 -a(2:n-1,2:n-1) = a(2:n-1,1:n-2) + a(2:n-1,3:n) + a(1:n-2,2:n-1) + a(3:n,2:n-1) -b(2:n-1,2:n-1) = a(2:n-1,2:n-1) -``` - -is equivalent to the array assignments - -```f90 -FORALL(i = 2:n-1, j = 2:n-1) - a(i,j) = a(i,j-1) + a(i,j+1) + a(i-1,j) + a(i+1,j) - b(i,j) = a(i,j) -END FORALL -``` - -The `FORALL` version is more readable. - -Assignment in a `FORALL` is like an array assignment: as if all the -expressions were evaluated in any order, held in temporary storage, then -all the assignments performed in any order. The first statement must -fully complete before the second can begin. - -A `FORALL` may be nested, and may include a `WHERE`. Procedures -referenced within a `FORALL` must be pure. - -### Array elements - -For a simple case, given - -```f90 -REAL, DIMENSION(100, 100) :: a -``` - -we can reference a single element as, for instance, `a(1, 1)`. For a -derived-data type like - -```f90 -TYPE fun_del - REAL u - REAL, DIMENSION(3) :: du -END TYPE fun_del -``` - -we can declare an array of that type: - -```f90 -TYPE(fun_del), DIMENSION(10, 20) :: tar -``` - -and a reference like - -```f90 -tar(n, 2) -``` - -is an element (a scalar!) of type fun_del, but - -```f90 -tar(n, 2)%du -``` - -is an array of type real, and - -```f90 -tar(n, 2)%du(2) -``` - -is an element of it. The basic rule to remember is that an array element -always has a subscript or subscripts qualifying at least the last name. - -### Array subobjects (sections) - -The general form of subscript for an array section is - -` [`*`lower`*`] : [`*`upper`*`] [:`*`stride`*`]` - -(where \[ \] indicates an optional item) as in - -```f90 -REAL a(10, 10) -a(i, 1:n) ! part of one row -a(1:m, j) ! part of one column -a(i, : ) ! whole row -a(i, 1:n:3) ! every third element of row -a(i, 10:1:-1) ! row in reverse order -a( (/ 1, 7, 3, 2 /), 1) ! vector subscript -a(1, 2:11:2) ! 11 is legal as not referenced -a(:, 1:7) ! rank two section -``` - -Note that a vector subscript with duplicate values cannot appear on the -left-hand side of an assignment as it would be ambiguous. Thus, - -```f90 -b( (/ 1, 7, 3, 7 /) ) = (/ 1, 2, 3, 4 /) -``` - -is illegal. Also, a section with a vector subscript must not be supplied -as an actual argument to an `OUT` or `INOUT` dummy argument. Arrays of -arrays are not allowed: - -```f90 -tar%du ! illegal -``` - -We note that a given value in an array can be referenced both as an -element and as a section: - -```f90 -a(1, 1) ! scalar (rank zero) -a(1:1, 1) ! array section (rank one) -``` - -depending on the circumstances or requirements. By qualifying objects of -derived type, we obtain elements or sections depending on the rule -stated earlier: - -```f90 -tar%u ! array section (structure component) -tar(1, 1)%u ! component of an array element -``` - -### Arrays intrinsic functions - -***Vector and matrix multiply*** - -| | | -|---------------|----------------------------------| -| `DOT_PRODUCT` | Dot product of 2 rank-one arrays | -| `MATMUL` | Matrix multiplication | - -***Array reduction*** - -| | | -|-----------|-------------------------------------------------------------| -| `ALL` | True if all values are true | -| `ANY` | True if any value is true. Example: `IF (ANY( a > b)) THEN` | -| `COUNT` | Number of true elements in array | -| `MAXVAL` | Maximum value in an array | -| `MINVAL` | Minimum value in an array | -| `PRODUCT` | Product of array elements | -| `SUM` | Sum of array elements | - -***Array inquiry*** - -| | | -|-------------|--------------------------------------| -| `ALLOCATED` | Array allocation status | -| `LBOUND` | Lower dimension bounds of an array | -| `SHAPE` | Shape of an array (or scalar) | -| `SIZE` | Total number of elements in an array | -| `UBOUND` | Upper dimension bounds of an array | - -***Array construction*** - -| | | -|----------|------------------------------------------------------| -| `MERGE` | Merge under mask | -| `PACK` | Pack an array into an array of rank one under a mask | -| `SPREAD` | Replicate array by adding a dimension | -| `UNPACK` | Unpack an array of rank one into an array under mask | - -***Array reshape*** - -| | | -|-----------|------------------| -| `RESHAPE` | Reshape an array | - -***Array manipulation*** - -| | | -|-------------|-----------------------------------| -| `CSHIFT` | Circular shift | -| `EOSHIFT` | End-off shift | -| `TRANSPOSE` | Transpose of an array of rank two | - -***Array location*** - -| | | -|----------|---------------------------------------------| -| `MAXLOC` | Location of first maximum value in an array | -| `MINLOC` | Location of first minimum value in an array | - - -## Pointers - -### Basics - -Pointers are variables with the `POINTER` attribute; they are not a -distinct data type (and so no 'pointer arithmetic' is possible). - -```f90 -REAL, POINTER :: var -``` - -They are conceptually a descriptor listing the attributes of the objects -(targets) that the pointer may point to, and the address, if any, of a -target. They have no associated storage until it is allocated or -otherwise associated (by pointer assignment, see -below): - -```f90 -ALLOCATE (var) -``` - -and they are dereferenced automatically, so no special symbol required. -In - -```f90 -var = var + 2.3 -``` - -the value of the target of var is used and modified. Pointers cannot be -transferred via I/O. The statement - -```f90 -WRITE *, var -``` - -writes the value of the target of var and not the pointer descriptor -itself. - -A pointer can point to another pointer, and hence to its target, or to a -static object that has the `TARGET` attribute: - -```f90 -REAL, POINTER :: object -REAL, TARGET :: target_obj -var => object ! pointer assignment -var => target_obj -``` - -but they are strongly typed: - -```f90 -INTEGER, POINTER :: int_var -var => int_var ! illegal - types must match -``` - -and, similarly, for arrays the ranks as well as the type must agree. - -A pointer can be a component of a derived type: - -```f90 -TYPE entry ! type for sparse matrix - REAL :: value - INTEGER :: index - TYPE(entry), POINTER :: next ! note recursion -END TYPE entry -``` - -and we can define the beginning of a linked chain of such entries: - -```f90 -TYPE(entry), POINTER :: chain -``` - -After suitable allocations and definitions, the first two entries could -be addressed as - -```f90 -chain%value chain%next%value -chain%index chain%next%index -chain%next chain%next%next -``` - -but we would normally define additional pointers to point at, for -instance, the first and current entries in the list. - -### Association - -A pointer's association status is one of Some care has to be taken not -to leave a pointer 'dangling' by use of `DEALLOCATE` on its target -without nullifying any other pointer referring to it. - -The intrinsic function `ASSOCIATED` can test the association status of a -defined pointer: - -```f90 -IF (ASSOCIATED(ptr)) THEN -``` - -or between a defined pointer and a defined target (which may, itself, be -a pointer): - -```f90 -IF (ASSOCIATED(ptr, target)) THEN -``` - -An alternative way to initialize a pointer, also in a specification -statement, is to use the `NULL` function: - -```f90 -REAL, POINTER, DIMENSION(:) :: vector => NULL() ! compile time -vector => NULL() ! run time -``` - -### Pointers in expressions and assignments - -For intrinsic types we can 'sweep' pointers over different sets of -target data using the same code without any data movement. Given the -matrix manipulation *y = B C z*, we can write the following code -(although, in this case, the same result could be achieved more simply -by other means): - -```f90 -REAL, TARGET :: b(10,10), c(10,10), r(10), s(10), z(10) -REAL, POINTER :: a(:,:), x(:), y(:) -INTEGER mult -: -DO mult = 1, 2 - IF (mult == 1) THEN - y => r ! no data movement - a => c - x => z - ELSE - y => s ! no data movement - a => b - x => r - END IF - y = MATMUL(a, x) ! common calculation -END DO -``` - -For objects of derived type we have to distinguish between pointer and -normal assignment. In - -```f90 -TYPE(entry), POINTER :: first, current -: -first => current -``` - -the assignment causes first to point at current, whereas - -```f90 -first = current -``` - -causes current to overwrite first and is equivalent to - -```f90 -first%value = current%value -first%index = current%index -first%next => current%next -``` - -### Pointer arguments - -If an actual argument is a pointer then, if the dummy argument is also a -pointer, - -- it must have same rank, -- it receives its association status from the actual argument, -- it returns its final association status to the actual argument - (note: the target may be undefined!), -- it may not have the `INTENT` attribute (it would be ambiguous), -- it requires an interface block. - -If the dummy argument is not a pointer, it becomes associated with the -target of the actual argument: - -```f90 - REAL, POINTER :: a (:,:) - : - ALLOCATE (a(80, 80)) - : - CALL sub(a) - : -SUBROUTINE sub(c) - REAL c(:, :) -``` - -### Pointer functions - -Function results may also have the `POINTER` attribute; this is useful -if the result size depends on calculations performed in the function, as -in - -```f90 -USE data_handler -REAL x(100) -REAL, POINTER :: y(:) -: -y => compact(x) -``` - -where the module data_handler contains - -```f90 -FUNCTION compact(x) - REAL, POINTER :: compact(:) - REAL x(:) - ! A procedure to remove duplicates from the array x - INTEGER n - : ! Find the number of distinct values, n - ALLOCATE(compact(n)) - : ! Copy the distinct values into compact -END FUNCTION compact -``` - -The result can be used in an expression (but must be associated with a -defined target). - -### Arrays of pointers - -These do not exist as such: given - -```f90 -TYPE(entry) :: rows(n) -``` - -then - -```f90 -rows%next ! illegal -``` - -would be such an object, but with an irregular storage pattern. For this -reason they are not allowed. However, we can achieve the same effect by -defining a derived data type with a pointer as its sole component: - -```f90 -TYPE row - REAL, POINTER :: r(:) -END TYPE -``` - -and then defining arrays of this data type - -```f90 -TYPE(row) :: s(n), t(n) -``` - -where the storage for the rows can be allocated by, for instance, - -```f90 -DO i = 1, n - ALLOCATE (t(i)%r(1:i)) ! Allocate row i of length i -END DO -``` - -The array assignment - -```f90 -s = t -``` - -is then equivalent to the pointer assignments - -```f90 -s(i)%r => t(i)%r -``` - -for all components. - -### Pointers as dynamic aliases - -Given an array - -```f90 -REAL, TARGET :: table(100,100) -``` - -that is frequently referenced with the fixed subscripts - -```f90 -table(m:n, p:q) -``` - -these references may be replaced by - -```f90 -REAL, DIMENSION(:, :), POINTER :: window - : -window => table(m:n, p:q) -``` - -The subscripts of window are - -```f90 -1:n-m+1, 1:q-p+1 -``` - -. Similarly, for - -```f90 -tar%u -``` - -(as defined in -already), -we can use, say, - -```f90 -taru => tar%u -``` - -to point at all the u components of tar, and subscript it as - -```f90 -taru(1, 2) -``` - -The subscripts are as those of tar itself. (This replaces yet more of -`EQUIVALENCE`.) - -In the pointer association - -```f90 -pointer => array_expression -``` - -the lower bounds for `pointer` are determined as if `lbound` was applied -to `array_expression`. Thus, when a pointer is assigned to a whole array -variable, it inherits the lower bounds of the variable, otherwise, the -lower bounds default to 1. - -Fortran -2003 allows specifying arbitrary lower bounds on pointer -association, like - -```f90 -window(r:,s:) => table(m:n,p:q) -``` - -so that the bounds of `window` become `r:r+n-m,s:s+q-p`. -Fortran 95 -does not have this feature; however, it can be simulated using the -following trick (based on the pointer association rules for assumed -shape array dummy arguments): - -```f90 -FUNCTION remap_bounds2(lb1,lb2,array) RESULT(ptr) - INTEGER, INTENT(IN) :: lb1,lb2 - REAL, DIMENSION(lb1:,lb2:), INTENT(IN), TARGET :: array - REAL, DIMENSION(:,:), POINTER :: ptr - ptr => array -END FUNCTION - : -window => remap_bounds2(r,s,table(m:n,p:q)) -``` - -The source code of an extended example of the use of pointers to support -a data structure is in -[pointer.f90](ftp://ftp.numerical.rl.ac.uk/pub/MRandC/pointer.f90). - - -## Intrinsic procedures - -Most of the intrinsic functions have already been mentioned. Here, we -deal only with their general classification and with those that have so -far been omitted. All intrinsic procedures can be used with keyword -arguments: - -```f90 -CALL DATE_AND_TIME (TIME=t) -``` - -and many have optional arguments. - -The intrinsic procedures are grouped into four categories: - -1. elemental - work on scalars or arrays, e.g. `ABS(a)`; -2. inquiry - independent of value of argument (which may be undefined), - e.g. `PRECISION(a)`; -3. transformational - array argument with array result of different - shape, e.g. `RESHAPE(a, b)`; -4. subroutines, e.g. `SYSTEM_CLOCK`. - -The procedures not already introduced are - -Bit inquiry - -| | | -|------------|-----------------------------| -| `BIT_SIZE` | Number of bits in the model | - -Bit manipulation - -| | | -|----------|--------------------| -| `BTEST` | Bit testing | -| `IAND` | Logical AND | -| `IBCLR` | Clear bit | -| `IBITS` | Bit extraction | -| `IBSET` | Set bit | -| `IEOR` | Exclusive OR | -| `IOR` | Inclusive OR | -| `ISHFT` | Logical shift | -| `ISHFTC` | Circular shift | -| `NOT` | Logical complement | - -Transfer function, as in - -```f90 -INTEGER :: i = TRANSFER('abcd', 0) -``` - -(replaces part of EQUIVALENCE) - -Subroutines - -| | | -|-----------------|-----------------------------------| -| `DATE_AND_TIME` | Obtain date and/or time | -| `MVBITS` | Copies bits | -| `RANDOM_NUMBER` | Returns pseudorandom numbers | -| `RANDOM_SEED` | Access to seed | -| `SYSTEM_CLOCK` | Access to system clock | -| `CPU_TIME` | Returns processor time in seconds | - - ## Data transfer ### Formatted input/output diff --git a/source/learn/f95_features/fprettify.rc b/source/learn/f95_features/fprettify.rc new file mode 100644 index 000000000000..82b2e3549c71 --- /dev/null +++ b/source/learn/f95_features/fprettify.rc @@ -0,0 +1,36 @@ +# style configuration file for fprettify +# original source: https://github.com/PHOTOX/ABIN/blob/master/.fprettify.rc +# original author: Daniel Hollas +# original licence: GPL v3 +# +# minor edits to the original to fit better the pattern other booklets use + +# Replace Fortran-style relational operators with C-style +# to make our code more readable for non-Fortran programmers +# for example '.lt.' to '<' +enable-replacements=False # in the original: True +c-relations=False # in the original: True + +# White space settings +indent=2 # in the original 3 +line-length=132 +strict-indent=True +strip-comments=True +whitespace-relational=True +whitespace-logical=True +whitespace-plusminus=True +whitespace-multdiv=True +whitespace-comma=True +whitespace-intrinsics=True +whitespace-print=False +whitespace-type=False + +# Control whitespace around '::' declarations +whitespace-decl=True +enable-decl=False # in the original: True (then lines shrink) + +# Don't indent pre-processor statements +disable-fypp=True + +case=[1,1,1,2] +exclude=[random.F90,fftw3.F90,force_cp2k.F90, h2o_schwenke.f, h2o_cvrqd.f] diff --git a/source/learn/f95_features/index.md b/source/learn/f95_features/index.md index 0995a603162d..58ed0b5870d9 100644 --- a/source/learn/f95_features/index.md +++ b/source/learn/f95_features/index.md @@ -4,6 +4,13 @@ :maxdepth: 2 :hidden: Language elements +Expressions and assignments +Control statements +Program units and procedures +Array handling +Pointers +Intrinsic procedures +Data transfer ::: This is an overview of **Fortran 95 language features** which is based diff --git a/source/learn/f95_features/intrinsic_procedures.md b/source/learn/f95_features/intrinsic_procedures.md new file mode 100644 index 000000000000..cfba9f81c59d --- /dev/null +++ b/source/learn/f95_features/intrinsic_procedures.md @@ -0,0 +1,60 @@ +# Intrinsic procedures + +Most of the intrinsic functions have already been mentioned. Here, we +deal only with their general classification and with those that have so +far been omitted. All intrinsic procedures can be used with keyword +arguments: + +```f90 +call date_and_time(TIME=t) +``` + +and many have optional arguments. + +The intrinsic procedures are grouped into four categories: + +1. elemental - work on scalars or arrays, e.g. `abs(a)`; +1. inquiry - independent of value of argument (which may be undefined), + e.g. `precision(a)`; +1. transformational - array argument with array result of different + shape, e.g. `reshape(a, b)`; +1. subroutines, e.g. `system_clock`. + +The procedures not already introduced are + +Bit inquiry + +| `bit_size` | Number of bits in the model | +|------------|-----------------------------| + +Bit manipulation + +| `btest` | Bit testing | +|----------|--------------------| +| `iand` | Logical AND | +| `ibclr` | Clear bit | +| `ibits` | Bit extraction | +| `ibset` | Set bit | +| `ieor` | Exclusive OR | +| `ior` | Inclusive OR | +| `ishft` | Logical shift | +| `ishftc` | Circular shift | +| `not` | Logical complement | + +Transfer function, as in + +```f90 +integer :: i = transfer('abcd', 0) +``` + +(replaces part of `equivalence`) + +Subroutines + +| `date_and_time` | Obtain date and/or time | +|-----------------|-----------------------------------| +| `mvbits` | Copies bits | +| `random_number` | Returns pseudorandom numbers | +| `random_seed` | Access to seed | +| `system_clock` | Access to system clock | +| `cpu_time` | Returns processor time in seconds | diff --git a/source/learn/f95_features/language_elements.md b/source/learn/f95_features/language_elements.md new file mode 100644 index 000000000000..c986e900466d --- /dev/null +++ b/source/learn/f95_features/language_elements.md @@ -0,0 +1,527 @@ +# Language elements + +Fortran is +[case-insensitive](https://en.wikipedia.org/wiki/Case_sensitivity) +The convention of writing +Fortran keywords in upper case and all other names in lower case is +adopted in this article; except, by way of contrast, in the input/output +descriptions +([Data transfer](data_transfer) +and +[Operations on external files](operations_on_external_files)). + +## Basics + +The basic component of the Fortran language is its *character set*. Its +members are + +- the letters A ... Z and a ... z (which are equivalent outside a + character context) +- the numerals 0 ... 9 +- the underscore \_ +- the special characters + `= : + blank - * / ( ) [ ] , . $ ' ! " % & ; < > ?` + +[Tokens](https://en.wikipedia.org/wiki/Token_(parser)) +that +have a syntactic meaning to the compiler are built from those +components. There are six classes of tokens: + +| Label | `123` | +|-----------|------------------------------------------------------| +| Constant | `123.456789_long` | +| Keyword | `allocatable` | +| Operator | `.add.` | +| Name | `solve_equation` (up to 31 characters, including \_) | +| Separator | `/ ( ) (/ /) [ ] , = => : :: ; %` | + +From the tokens, +[statements](https://en.wikipedia.org/wiki/Statement_(programming)) +are built. These can be coded using the +new free *source form* which does not require positioning in a rigid +column structure: + +```f90 +function string_concat(s1, s2) ! This is a comment + type(string), intent(IN) :: s1, s2 + type(string) string_concat + string_concat%string_data = s1%string_data(1:s1%length) // & + s2%string_data(1:s2%length) ! This is a continuation + string_concat%length = s1%length + s2%length +end function string_concat +``` + +Note the trailing comments and the trailing continuation mark. There may +be 39 continuation lines, and 132 characters per line. Blanks are +significant. Where a token or character constant is split across two +lines: + +```f90 + ... start_of& + &_name + ... 'a very long & + &string' +``` + +a leading `&` on the continued line is also required. + +## Intrinsic data types + +Fortran has five *intrinsic data types*: `integer`, `real`, `complex`, +`logical` and `character`. Each of those types can be additionally +characterized by a *kind*. Kind, basically, defines internal +representation of the type: for the three numeric types, it defines the +precision and range, and for the other two, the specifics of storage +representation. Thus, it is an abstract concept which models the limits +of data types' representation; it is expressed as a member of a set of +whole numbers (e.g. it may be {1, 2, 4, 8} for integers, denoting bytes +of storage), but those values are not specified by the Standard and not +portable. For every type, there is a *default kind*, which is used if no +kind is explicitly specified. For each intrinsic type, there is a +corresponding form of *literal constant*. The numeric types `integer` +and `real` can only be signed (there is no concept of sign for type +`complex`). + +### Literal constants and kinds + +#### `integer` + +Integer literal constants of the default kind take the form + +```f90 +1 0 -999 32767 +10 +``` + +`kind` can be defined as a named constant. If the desired range is +±10kind, the portable syntax for defining the appropriate +kind, `two_bytes` is + +```f90 +integer, parameter :: two_bytes = selected_int_kind(4) +``` + +that allows subsequent definition of constants of the form + +```f90 +-1234_two_bytes +1_two_bytes +``` + +Here, `two_bytes` is the kind type parameter; it can also be an explicit +default integer literal constant, like `-1234_2` but such use is non-portable. + +The `kind` function supplies the value of a kind type parameter: + +```f90 +kind(1) kind(1_two_bytes) +``` + +and the `range` function supplies the actual decimal range (so the user +must make the actual mapping to bytes): + +```f90 +range(1_two_bytes) +``` + +Also, in +[`data` (initialization) statements](data_statement), +binary (B), octal (O) and hexadecimal +(Z) constants may be used (often informally referred to as "BOZ +constants"): + +```f90 +B'01010101' O'01234567' Z'10fa' +``` + +#### `real` + +There are at least two real kinds - the default and one with greater +precision (this replaces `double precision`). `selected_real_kind` +functions returns the kind number for desired range and precision; for +at least 9 decimal digits of precision and a range of 10−99 +to 1099, it can be specified as: + +```f90 +integer, parameter :: long = selected_real_kind(9, 99) +``` + +and literals subsequently specified as `1.7_long`. + +Also, there are the intrinsic functions + +```f90 +kind(1.7_long) precision(1.7_long) range(1.7_long) +``` + +that give in turn the kind type value, the actual precision (here at +least `9`), and the actual range (here at least `99`). + +#### `complex` + +`complex` data type is built of two integer or real components: + +```f90 +(1, 3.7_long) +``` + +#### `logical` + +There are only two basic values of logical constants: `.true.` and +`.false.`. Here, there may also be different kinds. Logicals don't have +their own kind inquiry functions, but use the kinds specified for +`integer`s; default kind of `logical` is the same as of `integer`. + +```f90 +.false. .true._one_byte +``` + +and the `kind` function operates as expected: + +```f90 +kind(.true.) +``` + +#### `character` + +The forms of literal constants for `character` data type are + +```f90 +'A string' "Another" 'A "quote"' ''''''' +``` + +(the last being an empty string). Different kinds are allowed (for +example, to distinguish +[ASCII](https://en.wikipedia.org/wiki/ASCII) +and +[UNICODE](https://en.wikipedia.org/wiki/UNICODE) +strings), +but not widely supported by compilers. Again, the kind value is given by +the `kind` function: + +```f90 +KIND('ASCII') +``` + +### Number model and intrinsic functions + +The numeric types are based on number models with associated inquiry +functions (whose values are independent of the values of their +arguments; arguments are used only to provide kind). These functions are +important for portable numerical software: + +| `digits(x)` | Number of significant digits | +|------------------|------------------------------------------| +| `epsilon(x)` | Almost negligible compared to one (real) | +| `huge(x)` | Largest number | +| `maxexponent(x)` | Maximum model exponent (real) | +| `minexponent(x)` | Minimum model exponent (real) | +| `precision(x)` | Decimal precision (real, complex) | +| `radix(x)` | Base of the model | +| `range(x)` | Decimal exponent range | +| `tiny(x)` | Smallest positive number (real) | + +## Scalar variables + +Scalar +[variables](https://en.wikipedia.org/wiki/Variable_(programming)) +corresponding to the five intrinsic +types are specified as follows: + +```f90 +integer(kind=2) :: i +real(kind=long) :: a +complex :: current +logical :: Pravda +character(len=20) :: word +character(len=2, kind=Kanji) :: kanji_word +``` + +where the optional `kind` parameter specifies a non-default kind, and +the `::` notation delimits the type and attributes from variable name(s) +and their optional initial values, allowing full variable specification +and initialization to be typed in one statement (in previous standards, +attributes and initializers had to be declared in several statements). +While it is not required in above examples (as there are no additional +attributes and initialization), most Fortran-90 programmers acquire the +habit to use it everywhere. + +The `len=` specifier is applicable only to `character`s and specifies the string +length (replacing the older `*len` form). The explicit `kind=` and +`len=` specifiers are optional: + +```f90 +CHARACTER(2, Kanji) :: kanji_word +``` + +works just as well. + +There are some other interesting character features. Just as a substring +as in + +```f90 +character(80) :: line +... = line(i:i) ! substring +``` + +was previously possible, so now is the substring + +```f90 +'0123456789'(i:i) +``` + +Also, zero-length strings are allowed: + +```f90 +line(i:i-1) ! zero-length string +``` + +Finally, there is a set of intrinsic character functions, examples being + +| `achar` | `iachar` (for ASCII set) | +|------------|------------------------------| +| `adjustl` | `adjustr` | +| `len_trim` | `index(s1, s2, back=.true.)` | +| `repeat` | `scan`(for one of a set) | +| `trim` | `verify`(for all of a set) | + +## Derived data types + +For derived data types, the form of the type must be defined first: + +```f90 +type person + character(10) name + real age +end type person +``` + +and then, variables of that type can be defined: + +```f90 +type(person) you, me +``` + +To select components of a derived type, `%` qualifier is used: + +```f90 +you%age +``` + +Literal constants of derived types have the form +`TypeName(1stComponentLiteral, 2ndComponentLiteral, ...)`: + +```f90 +you = person("Smith", 23.5) +``` + +which is known as a *structure constructor*. Definitions may refer to a +previously defined type: + +```f90 +type point + real x, y +end type point +type triangle + type(point) a, b, c +end type triangle +``` + +and for a variable of `type triangle`, as in + +```f90 +type(triangle) t +``` + +each component of type `point` is accessed as + +```f90 +t%a t%b t%c +``` + +which, in turn, have ultimate components of `type real`: + +```f90 +t%a%x t%a%y t%b%x etc. +``` + +(Note that the `%` qualifier was chosen rather than dot (`.`) because of +potential ambiguity with operator notation, like `.OR.`). + +## Implicit and explicit typing + +Unless specified otherwise, all variables starting with letters `i`, `j`, `k`, +`l`, `m` and `n`are default `integer`s, and all others are default `real`; +other data types must be explicitly declared. This is known as *implicit +typing* and is a heritage of early FORTRAN days. Those defaults can be +overridden by *`IMPLICIT TypeName (CharacterRange)`* statements, like: + +```f90 +implicit complex(z) +implicit character(a-b) +implicit real(c-h,n-y) +``` + +However, it is a good practice to explicitly type all variables, and +this can be forced by inserting the statement + +```f90 +implicit none +``` + +at the beginning of each program unit. + +## Arrays + +Arrays are considered to be variables in their own right. Every array is +characterized by its +[type](https://en.wikipedia.org/wiki/Type_(computer_programming)), +[rank](https://en.wikipedia.org/wiki/Rank_(computer_programming)), +and *shape* (which defines the extents of each +dimension). Bounds of each dimension are by default `1` and *size*, but +arbitrary bounds can be explicitly specified. The `dimension` keyword is +optional and considered an attribute; if omitted, the array shape must +be specified after array-variable name. For example, + +```f90 +real:: a(10) +integer, dimension(0:100, -50:50) :: map +``` + +declares two arrays, `rank-1` and `rank-2`, whose elements are in +[column-major order](https://en.wikipedia.org/wiki/Column-major_order). +Elements are, for example, + +```f90 +a(1) a(i*j) +``` + +and are scalars. The subscripts may be any scalar integer expression. + +*Sections* are parts of the array variables, and are arrays themselves: + +```f90 +a(i:j) ! rank one +map(i:j, k:l:m) ! rank two +a(map(i, k:l)) ! vector subscript +a(3:2) ! zero length +``` + +Whole arrays and array sections are array-valued objects. Array-valued +constants (constructors) are available, enclosed in `(/ ... /)`: + +```f90 +(/ 1, 2, 3, 4 /) +(/ ( (/ 1, 2, 3 /), i = 1, 4) /) +(/ (i, i = 1, 9, 2) /) +(/ (0, i = 1, 100) /) +(/ (0.1*i, i = 1, 10) /) +``` + +making use of an implied-`do loop` notation. Fortran 2003 allows the use +of brackets: `[1, 2, 3, 4]` and `[([1,2,3], i=1,4)]` instead of the +first two examples above, and many compilers support this now. A derived +data type may, of course, contain array components: + +```f90 +type triplet + real, dimension(3) :: vertex +end type triplet +type(triplet), dimension(4) :: t +``` + +so that + +- `t(2)` is a scalar (a structure) +- `t(2)%vertex` is an array component of a scalar + +## Data initialization + +Variables can be given initial values as specified in a specification +statement: + +```f90 +real, dimension(3) :: a = (/ 0.1, 0.2, 0.3 /) +``` + +and a default initial value can be given to the component of a derived +data type: + +```f90 +type triplet + real, dimension(3) :: vertex = 0.0 +end type triplet +``` + +When local variables are initialized within a procedure they implicitly +acquire the `save` attribute: + +```f90 +real, dimension(3) :: point = (/0.0, 1.0, -1.0/) +``` + +This declaration is equivalent to + +```f90 +real, dimension(3), save :: point = (/0.0, 1.0, -1.0/) +``` + +for local variables within a subroutine or function. The SAVE attribute +causes local variables to retain their value after a procedure call and +then to initialize the variable to the saved value upon returning to the +procedure. + +### `parameter` attribute + +A named constant can be specified directly by adding the `parameter` +attribute and the constant values to a type statement: + +```f90 +real, dimension(3), parameter :: field = (/0., 1., 2./) +type(triplet), parameter :: t = triplet((/0., 0., 0./)) +``` + +### `data` statement + +The `data` statement can be used for scalars and also for arrays and +variables of derived type. It is also the only way to initialise just +parts of such objects, as well as to initialise to binary, octal or +hexadecimal values: + +```f90 +type(triplet) :: t1, t2 +data t1/triplet((/0., 1., 2./))/, t2%vertex(1)/123./ +data array(1:64)/64*0/ +data i, j, k/B'01010101', O'77', Z'ff'/ +``` + +### Initialization expressions + +The values used in `data` and `parameter` statements, or with these +attributes, are constant expressions that may include references to: +array and structure constructors, elemental intrinsic functions with +integer or character arguments and results, and the six transformational +functions `repeat, selected_int_kind, trim, selected_real_kind, reshape` +and `transfer` (see +[Intrinsic procedures](intrinsic_procedures): + +```f90 +integer, parameter :: long = selected_real_kind(12), & + array(3) = (/1, 2, 3/) +``` + +## Specification expressions + +It is possible to specify details of variables using any non-constant, +scalar, integer expression that may also include inquiry function +references: + +```f90 +subroutine s(b, m, c) + use mod ! contains a + real, dimension(:, :) :: b + real, dimension(ubound(b, 1) + 5) :: x + integer :: m + character(LEN=*) :: c + character(LEN=m + len(c)) :: cc + real(selected_real_kind(2*precision(a))) :: z +end subroutine +``` diff --git a/source/learn/f95_features/pointers.md b/source/learn/f95_features/pointers.md new file mode 100644 index 000000000000..284fafab8e3f --- /dev/null +++ b/source/learn/f95_features/pointers.md @@ -0,0 +1,332 @@ +# Pointers + +## Basics + +Pointers are variables with the `pointer` attribute; they are not a +distinct data type (and so no 'pointer arithmetic' is possible). + +```f90 +real, pointer :: var +``` + +They are conceptually a descriptor listing the attributes of the objects +(targets) that the pointer may point to, and the address, if any, of a +target. They have no associated storage until it is allocated or +otherwise associated (by pointer assignment, see +[Pointers in expressions and assignments](Pointers_in_expressions_and_assignments): + +```f90 +allocate (var) +``` + +and they are dereferenced automatically, so no special symbol required. +In + +```f90 +var = var + 2.3 +``` + +the value of the target of var is used and modified. Pointers cannot be +transferred via I/O. The statement + +```f90 +write *, var +``` + +writes the value of the target of var and not the pointer descriptor +itself. + +A pointer can point to another pointer, and hence to its target, or to a +static object that has the `target` attribute: + +```f90 +real, pointer :: object +real, target :: target_obj +var => object ! pointer assignment +var => target_obj +``` + +but they are strongly typed: + +```f90 +integer, pointer :: int_var +var => int_var ! illegal - types must match +``` + +and, similarly, for arrays the ranks as well as the type must agree. + +A pointer can be a component of a derived type: + +```f90 +type entry ! type for sparse matrix + real :: value + integer :: index + type(entry), pointer :: next ! note recursion +end type entry +``` + +and we can define the beginning of a linked chain of such entries: + +```f90 +type(entry), pointer :: chain +``` + +After suitable allocations and definitions, the first two entries could +be addressed as + +```f90 +chain%value chain%next%value +chain%index chain%next%index +chain%next chain%next%next +``` + +but we would normally define additional pointers to point at, for +instance, the first and current entries in the list. + +## Association + +A pointer's association status is one of Some care has to be taken not +to leave a pointer 'dangling' by use of `deallocate` on its target +without nullifying any other pointer referring to it. + +The intrinsic function `associated` can test the association status of a +defined pointer: + +```f90 +if (associated(ptr)) then +``` + +or between a defined pointer and a defined target (which may, itself, be +a pointer): + +```f90 +if (associated(ptr, target)) then +``` + +An alternative way to initialize a pointer, also in a specification +statement, is to use the `null` function: + +```f90 +real, pointer, dimension(:) :: vector => null() ! compile time +vector => null() ! run time +``` + +## Pointers in expressions and assignments + +For intrinsic types we can 'sweep' pointers over different sets of +target data using the same code without any data movement. Given the +matrix manipulation *y = B C z*, we can write the following code +(although, in this case, the same result could be achieved more simply +by other means): + +```f90 +real, target :: b(10, 10), c(10, 10), r(10), s(10), z(10) +real, pointer :: a(:, :), x(:), y(:) +integer mult +: +do mult = 1, 2 + if (mult == 1) then + y => r ! no data movement + a => c + x => z + else + y => s ! no data movement + a => b + x => r + end if + y = matmul(a, x) ! common calculation +end do +``` + +For objects of derived type we have to distinguish between pointer and +normal assignment. In + +```f90 +type(entry), pointer :: first, current +: +first => current +``` + +the assignment causes first to point at current, whereas + +```f90 +first = current +``` + +causes current to overwrite first and is equivalent to + +```f90 +first%value = current%value +first%index = current%index +first%next => current%next +``` + +## Pointer arguments + +If an actual argument is a pointer then, if the dummy argument is also a +pointer, + +- it must have same rank, +- it receives its association status from the actual argument, +- it returns its final association status to the actual argument + (note: the target may be undefined!), +- it may not have the `intent` attribute (it would be ambiguous), +- it requires an interface block. + +If the dummy argument is not a pointer, it becomes associated with the +target of the actual argument: + +```f90 +real, pointer :: a(:, :) +: +allocate (a(80, 80)) +: +call sub(a) +: +subroutine sub(c) + real c(:, :) +``` + +## Pointer functions + +Function results may also have the `pointer` attribute; this is useful +if the result size depends on calculations performed in the function, as +in + +```f90 +use data_handler +real x(100) +real, pointer :: y(:) +: +y => compact(x) +``` + +where the module data_handler contains + +```f90 +function compact(x) + real, pointer :: compact(:) + real x(:) + ! A procedure to remove duplicates from the array x + integer n + : ! Find the number of distinct values, n + allocate (compact(n)) + : ! Copy the distinct values into compact +end function compact +``` + +The result can be used in an expression (but must be associated with a +defined target). + +## Arrays of pointers + +These do not exist as such: given + +```f90 +type(entry) :: rows(n) +``` + +then + +```f90 +rows%next ! illegal +``` + +would be such an object, but with an irregular storage pattern. For this +reason they are not allowed. However, we can achieve the same effect by +defining a derived data type with a pointer as its sole component: + +```f90 +type row + real, pointer :: r(:) +end type +``` + +and then defining arrays of this data type + +```f90 +type(row) :: s(n), t(n) +``` + +where the storage for the rows can be allocated by, for instance, + +```f90 +do i = 1, n + allocate (t(i)%r(1:i)) ! Allocate row i of length i +end do +``` + +The array assignment `s = t` is then equivalent to the pointer +assignments + +```f90 +s(i)%r => t(i)%r +``` + +for all components. + +## Pointers as dynamic aliases + +Given an array + +```f90 +real, target :: table(100, 100) +``` + +that is frequently referenced with the fixed subscripts + +```f90 +table(m:n, p:q) +``` + +these references may be replaced by + +```f90 +REAL, DIMENSION(:, :), POINTER :: window + : +window => table(m:n, p:q) +``` + +The subscripts of window are `1:n - m + 1, 1:q - p + 1`. +Similarly, for `tar%u` (as defined in +[Array elements](array_elements)), +we can use, say, `taru => tar%u` +to point at all the u components of tar, and subscript it as +`taru(1, 2)`. +The subscripts are as those of tar itself. (This replaces yet more of +`equivalence`.) + +In the pointer association `pointer => array_expression` +the lower bounds for `pointer` are determined as if `lbound` was applied +to `array_expression`. Thus, when a pointer is assigned to a whole array +variable, it inherits the lower bounds of the variable, otherwise, the +lower bounds default to `1`. + +[Fortran 2003](https://en.wikipedia.org/wiki/Fortran#Fortran_2003) +allows specifying arbitrary lower bounds on pointer +association, like + +```f90 +window(r:, s:) => table(m:n, p:q) +``` + +so that the bounds of `window` become `r:r + n - m, s:s + q - p`. +[Fortran 95](https://en.wikipedia.org/wiki/Fortran_95) +does not have this feature; however, it can be simulated using the +following trick (based on the pointer association rules for assumed +shape array dummy arguments): + +```f90 +function remap_bounds2(lb1, lb2, array) result(ptr) + integer, intent(IN) :: lb1, lb2 + real, dimension(lb1:, lb2:), intent(IN), target :: array + real, dimension(:, :), pointer :: ptr + ptr => array +end function +: +window => remap_bounds2(r, s, table(m:n, p:q)) +``` + +The source code of an extended example of the use of pointers to support +a data structure is in +[pointer.f90](ftp://ftp.numerical.rl.ac.uk/pub/MRandC/pointer.f90). diff --git a/source/learn/f95_features/program_units_and_procedures.md b/source/learn/f95_features/program_units_and_procedures.md new file mode 100644 index 000000000000..8d76bd3c0a7e --- /dev/null +++ b/source/learn/f95_features/program_units_and_procedures.md @@ -0,0 +1,378 @@ +# Program units and procedures + +## Definitions + +In order to discuss this topic we need some definitions. In logical +terms, an executable program consists of one *main program* and zero or +more *subprograms* (or *procedures*) - these do something. Subprograms +are either *functions* or *subroutines*, which are either *external, +internal* or *module* subroutines. (External subroutines are what we +knew from FORTRAN 77.) + +From an organizational point of view, however, a complete program +consists of *program units*. These are either *main programs, external +subprograms* or *modules* and can be separately compiled. + +An example of a main (and complete) program is + +```f90 +program test + print*,'Hello world!' +end program test +``` + +An example of a main program and an external subprogram, forming an +executable program, is + +```f90 +program test + call print_message +end program test + +subroutine print_message + print*,'Hello world!' +end subroutine print_message +``` + +The form of a function is + +```f90 +function name(arg1, arg2) ! zero or more arguments + : + name = ... + : +end function name +``` + +The form of reference of a function is + +```f90 +x = name(a, b) +``` + +## Internal procedures + +An internal subprogram is one *contained* in another (at a maximum of +one level of nesting) and provides a replacement for the statement +function: + +```f90 +subroutine outer + real x, y + : +contains + subroutine inner + real y + y = x + 1. + : + end subroutine inner ! subroutine mandatory +end subroutine outer +``` + +We say that `outer` is the *host* of `inner`, and that `inner` obtains +access to entities in `outer` by *host association* (e.g. to `x`), +whereas `y` is a *local* variable to `inner`. + +The *scope* of a named entity is a *scoping unit*, here `outer` less +`inner`, and `inner`. + +The names of program units and external procedures are *global*, and the +names of implied-DO variables have a scope of the statement that +contains them. + +## Modules + +Modules are used to package + +- global data (replaces COMMON and BLOCK DATA from Fortran 77); +- type definitions (themselves a scoping unit); +- subprograms (which among other things replaces the use of ENTRY from + Fortran 77); +- interface blocks (another scoping unit, see + [Interface blocks](interface_blocks); +- namelist groups (see any textbook). + +An example of a module containing a type definition, interface block and +function subprogram is + +```f90 +module interval_arithmetic + type interval + real lower, upper + end type interval + interface operator(+) + module procedure add_intervals + end interface + : +contains + function add_intervals(a, b) + type(interval), intent(IN) :: a, b + type(interval) add_intervals + add_intervals%lower = a%lower + b%lower + add_intervals%upper = a%upper + b%upper + end function add_intervals ! function mandatory + : +end module interval_arithmetic +``` + +and the simple statement + +```f90 + +use interval_arithmetic +``` + +provides *use association* to all the module's entities. Module +subprograms may, in turn, contain internal subprograms. + +## Controlling accessibility + +The `public` and `private` attributes are used in specifications in +modules to limit the scope of entities. The attribute form is + +```f90 +real, public :: x, y, z ! default +integer, private :: u, v, w +``` + +and the statement form is + +```f90 +public :: x, y, z, operator(.add.) +private :: u, v, w, assignment(=), operator(*) +``` + +The statement form has to be used to limit access to operators, and can +also be used to change the overall default: + +```f90 +private ! sets default for module +public :: only_this +``` + +For derived types there are three possibilities: the type and its +components are all `public`, the type is `public` and its components `private` +(the type only is visible and one can change its details easily), or all +of it is `private` (for internal use in the module only): + +```f90 +module mine + private + type, public :: list + real x, y + type(list), pointer :: next + end type list + type(list) :: tree + : +end module mine +``` + +The `use` statement's purpose is to gain access to entities in a module. +It has options to resolve name clashes if an imported name is the same +as a local one: + +```f90 +use mine, local_list => list +``` + +or to restrict the used entities to a specified set: + +```f90 +use mine, only : list +``` + +These may be combined: + +```f90 +use mine, only : local_list => list +``` + +## Arguments + +We may specify the intent of dummy arguments: + +```f90 +subroutine shuffle(ncards, cards) + integer, intent(IN) :: ncards + integer, intent(OUT), dimension(ncards) :: cards +``` + +Also, `INOUT` is possible: here the actual argument must be a variable +(unlike the default case where it may be a constant). + +Arguments may be optional: + +```f90 +subroutine mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstart) + real, optional, dimension :: upper, lower + : + if (present(lower)) then ! test for presence of actual argument + : +``` + +allows us to call `mincon` by + +```f90 +call mincon(n, f, x, upper) +``` + +Arguments may be keyword rather than positional (which come first): + +```f90 +call mincon(n, f, x, equalities=0, xstart=x0) +``` + +Optional and keyword arguments are handled by explicit interfaces, that +is with internal or module procedures or with interface blocks. + +## Interface blocks + +Any reference to an internal or module subprogram is through an +interface that is 'explicit' (that is, the compiler can see all the +details). A reference to an external (or dummy) procedure is usually +'implicit' (the compiler assumes the details). However, we can provide +an explicit interface in this case too. It is a copy of the header, +specifications and END statement of the procedure concerned, either +placed in a module or inserted directly: + +```f90 +real function minimum(a, b, func) + ! returns the minimum value of the function func(x) + ! in the interval (a,b) + real, intent(in) :: a, b + interface + real function func(x) + real, intent(IN) :: x + end function func + end interface + real f, x + : + f = func(x) ! invocation of the user function. + : +end function minimum +``` + +An explicit interface is obligatory for + +- optional and keyword arguments; +- `pointer` and `target` arguments (see + [Pointers](Pointers); +- `pointer` function result; +- new-style array arguments and array functions + ([Array handling](Array_handling)). + +It allows full checks at compile time between actual and dummy +arguments. + +**In general, the best way to ensure that a procedure interface is +explicit is either to place the procedure concerned in a module or to +use it as an internal procedure.** + +## Overloading and generic interfaces + +Interface blocks provide the mechanism by which we are able to define +generic names for specific procedures: + +```f90 +interface gamma ! generic name + function sgamma(X) ! specific name + real(selected_real_kind(6)) sgamma, x + end + function dgamma(X) ! specific name + real(selected_real_kind(12)) dgamma, x + end +end interface gamma +``` + +where a given set of specific names corresponding to a generic name must +all be of functions or all of subroutines. If this interface is within a +module, then it is simply + +```f90 +interface gamma + module procedure sgamma, dgamma +end interface +``` + +We can use existing names, e.g. SIN, and the compiler sorts out the +correct association. + +We have already seen the use of interface blocks for defined operators +and assignment (see +[Modules](Modules). + +## Recursion + +Indirect recursion is useful for multi-dimensional integration. For + +```f90 +volume = integrate(fy, ybounds) +``` + +We might have + +```f90 +recursive function integrate(f, bounds) + ! Integrate f(x) from bounds(1) to bounds(2) + real integrate + interface + function f(x) + real f, x + end function f + end interface + real, dimension(2), intent(IN) :: bounds + : +end function integrate +``` + +and to integrate `f(x, y)` over a rectangle: + +```f90 +function fy(y) + use func ! module func contains function f + real fy, y + yval = y + fy = integrate(f, xbounds) +end +``` + +Direct recursion is when a procedure calls itself, as in + +```f90 +recursive function factorial(n) result(res) + integer res, n + if (n .eq. 0) then + res = 1 + else + res = n * factorial(n - 1) + end if +end +``` + +Here, we note the `result` clause and termination test. + +## Pure procedures + +This is a feature for parallel computing. + +In +[the `forall` statement and construct](forall_statement_and_construct), +any side effects in a function can impede optimization on +a parallel processor the order of execution of the assignments could +affect the results. To control this situation, we add the `pure` keyword +to the `subroutine` or `function` statement an assertion that the +procedure (expressed simply): + +- alters no global variable, +- performs no I/O, +- has no saved variables (variables with the `save` attribute that + retains values between invocations), and +- for functions, does not alter any of its arguments. + +A compiler can check that this is the case, as in + +```f90 +pure function calculate(x) +``` + +All the intrinsic functions are `pure`. From a856a4bfd4bcebf17ebffa9a3ebbf7aa7eab0857 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Mon, 10 Mar 2025 19:50:15 +0100 Subject: [PATCH 08/10] add bibliography.md This copies the mediawiki source code block of the Wikipedia article's bibliography. It will be edited after the other sections are revised. Signed-off-by: Norwid Behrnd --- data/learning.yml | 2 + source/learn/f95_features/array_handling.md | 83 ++-- source/learn/f95_features/bibliography.md | 20 + source/learn/f95_features/data_transfer.md | 75 ++-- .../expressions_and_assignments.md | 50 +-- source/learn/f95_features/f95_features.md | 413 ------------------ source/learn/f95_features/index.md | 9 +- .../f95_features/intrinsic_procedures.md | 43 +- .../learn/f95_features/language_elements.md | 144 +++--- .../operations_on_external_files.md | 98 +++++ source/learn/f95_features/pointers.md | 22 +- .../program_units_and_procedures.md | 45 +- 12 files changed, 359 insertions(+), 645 deletions(-) create mode 100644 source/learn/f95_features/bibliography.md delete mode 100644 source/learn/f95_features/f95_features.md create mode 100644 source/learn/f95_features/operations_on_external_files.md diff --git a/data/learning.yml b/data/learning.yml index db2145e60496..0e81269b8aba 100644 --- a/data/learning.yml +++ b/data/learning.yml @@ -300,6 +300,8 @@ books: - /learn/f95_features/pointers - /learn/f95_features/intrinsic_procedures - /learn/f95_features/data_transfer + - /learn/f95_features/operations_on_external_files + - /learn/f95_features/bibliography # Web links listed at the bottom of the 'Learn' landing page # diff --git a/source/learn/f95_features/array_handling.md b/source/learn/f95_features/array_handling.md index 01c081b9994d..72c9abf32b12 100644 --- a/source/learn/f95_features/array_handling.md +++ b/source/learn/f95_features/array_handling.md @@ -52,7 +52,7 @@ call sub(a) the corresponding dummy argument specification defines only the type and rank of the array, not its shape. This information has to be made available by an explicit interface, often using an interface block (see -[Interface blocks](interface_blocks). +[Interface blocks](interface_blocks)). Thus we write just ```f90 @@ -60,8 +60,8 @@ subroutine sub(da) real, dimension(:, :) :: da ``` -and this is as if `da` were dimensioned `(11,21)`. However, we can specify -any lower bound and the array maps accordingly. +and this is as if `da` were dimensioned `(11,21)`. However, we can +specify any lower bound and the array maps accordingly. ```f90 real, dimension(0:, 0:) :: da @@ -102,7 +102,7 @@ end module program main use work_array read (input, *) n - allocate (work(n, 2 * n, 3 * n), STAT=status) + allocate (work(n, 2 * n, 3 * n), stat=status) : deallocate (work) ``` @@ -159,7 +159,7 @@ parallel processors. An elemental procedure must be pure. ```f90 elemental subroutine swap(a, b) - real, intent(INOUT) :: a, b + real, intent(inout) :: a, b real :: work work = a a = b @@ -313,9 +313,7 @@ always has a subscript or subscripts qualifying at least the last name. ## Array subobjects (sections) The general form of subscript for an array section is - -` [`*`lower`*`] : [`*`upper`*`] [:`*`stride`*`]` - +`[lower]:[upper][:stride]` (where `[...]` indicates an optional item) as in ```f90 @@ -366,52 +364,59 @@ tar(1, 1)%u ! component of an array element ### Vector and matrix multiply -| `dot_product` | Dot product of 2 rank-one arrays | -|---------------|----------------------------------| -| `matmul` | Matrix multiplication | +```{csv-table} +`dot_product`, "Dot product of 2 rank-one arrays" +`matmul`, "Matrix multiplication" +``` ### Array reduction -| `all` | True if all values are true | -|-----------|-------------------------------------------------------------| -| `any` | True if any value is true. Example: `if (any( a > b)) then` | -| `count` | Number of true elements in array | -| `maxval` | Maximum value in an array | -| `minval` | Minimum value in an array | -| `product` | Product of array elements | -| `sum` | Sum of array elements | +```{csv-table} +`all`, "True if all values are true" +`any`, "True if any value is true. Example: `if (any( a > b)) then`" +`count`, "Number of true elements in array" +`maxval`, "Maximum value in an array" +`minval`, "Minimum value in an array" +`product`, "Product of array elements" +`sum`, "Sum of array elements" +``` ### Array inquiry -| `allocated` | Array allocation status | -|-------------|--------------------------------------| -| `lbound` | Lower dimension bounds of an array | -| `shape` | Shape of an array (or scalar) | -| `size` | Total number of elements in an array | -| `ubound` | Upper dimension bounds of an array | +```{csv-table} +`allocated`, "Array allocation status" +`lbound`, "Lower dimension bounds of an array" +`shape`, "Shape of an array (or scalar)" +`size`, "Total number of elements in an array" +`ubound`, "Upper dimension bounds of an array" +``` ### Array construction -| `merge` | Merge under mask | -|----------|------------------------------------------------------| -| `pack` | Pack an array into an array of rank one under a mask | -| `spread` | Replicate array by adding a dimension | -| `unpack` | Unpack an array of rank one into an array under mask | +```{csv-table} +`merge`, "Merge under mask" +`pack`, "Pack an array into an array of rank one under a mask" +`spread`, "Replicate array by adding a dimension" +`unpack`, "Unpack an array of rank one into an array under mask" +``` ### Array reshape -| `reshape` | Reshape an array | -|-----------|------------------| +```{csv-table} +`reshape`, "Reshape an array" +``` ### Array manipulation -| `cshift` | Circular shift | -|-------------|-----------------------------------| -| `eoshift` | End-off shift | -| `transpose` | Transpose of an array of rank two | +```{csv-table} +`cshift`, "Circular shift" +`eoshift`, "End-off shift" +`transpose`, "Transpose of an array of rank two" +``` ### Array location -| `maxloc` | Location of first maximum value in an array | -|----------|---------------------------------------------| -| `minloc` | Location of first minimum value in an array | +```{csv-table} +`maxloc`, "Location of first maximum value in an array" +`minloc`, "Location of first minimum value in an array" +``` diff --git a/source/learn/f95_features/bibliography.md b/source/learn/f95_features/bibliography.md new file mode 100644 index 000000000000..a86be76b5862 --- /dev/null +++ b/source/learn/f95_features/bibliography.md @@ -0,0 +1,20 @@ +# Bibliography + +* Metcalf, Michael; Reid, John; Cohen, Malcolm (2004-06-17), + *Fortran 95/2003 Explained*, Oxford University PressOxford, + , ISBN 978-0-19-852692-6. +* [Introduction to Modern Fortran](https://doi.org/10.1007/0-387-28123-1_2), + Statistics and Computing, New York: Springer-Verlag, 2005, + , ISBN 0-387-23817-4 +* Gehrke, Wilhelm (1996). + [Fortran 95 Language Guide](https://doi.org/10.1007/978-1-4471-1025-5). + . ISBN 978-3-540-76062-7 +* Chivers, Ian; Sleightholme, Jane (2000), + [Fortran 2000 and Various Fortran Dialects](https://doi.org/10.1007/978-1-4471-0403-2_29), + in *Introducing Fortran 95*, London: Springer London, pp. 377–388, + , ISBN 978-1-85233-276-1 +* Counihan, Martin (2006). *Fortran 95* (2nd ed.). CRC Press. ISBN 9780203978467 +* Ramaraman, V. (1997). *Computer programming in FORTRAN 90 and 95*. + PHI Learning Pvt. Ltd. ISBN 9788120311817. +* Joshi, Yogendra Prasad. *An Introduction to Fortran 90/95: Syntax and + Programming.* Allied Publishers. ISBN 9788177644746. diff --git a/source/learn/f95_features/data_transfer.md b/source/learn/f95_features/data_transfer.md index 25e3f98c9b69..2bc24f368373 100644 --- a/source/learn/f95_features/data_transfer.md +++ b/source/learn/f95_features/data_transfer.md @@ -3,8 +3,7 @@ ## Formatted input/output These examples illustrate various forms of I/O lists with some simple -formats (see -below): +formats (see [below](edit_descriptors)): ```f90 integer :: i @@ -60,8 +59,7 @@ print form, q ``` or as an asterisk this is a type of I/O known as *list-directed* I/O -(see -below), +(see [below](list-directed-i/o), in which the format is defined by the computer system: ```f90 @@ -75,27 +73,26 @@ do not reference any unit number: this is referred to as terminal I/O. Otherwise the form is: ```f90 -read (UNIT=4, FMT="(f10.3)") q -read (UNIT=newunit, FMT="(f10.3)") q -read (UNIT=4 * i + j, FMT="(f10.3)") a +read (unit=4, fmt="(f10.3)") q +read (unit=newunit, fmt="(f10.3)") q +read (unit=4 * i + j, fmt="(f10.3)") a ``` where `unit=` is optional. The value may be any nonnegative integer -allowed by the system for this purpose (but `0`, `5` and `6` often denote the -error, keyboard and terminal, respectively). +allowed by the system for this purpose (but `0`, `5` and `6` often +denote the error, keyboard and terminal, respectively). An asterisk is a variantagain from the keyboard: ```f90 -read (UNIT=*, FMT="(f10.3)") q +read (unit=*, fmt="(f10.3)") q ``` A read with a unit specifier allows -exception handling: +[exception handling](https://en.wikipedia.org/wiki/Exception_handling): ```f90 -read (UNIT=NUNIT, FMT="(3f10.3)", IOSTAT=ios) a, b, c +read (unit=nunit, fmt="(3f10.3)", iostat=ios) a, b, c if (ios == 0) then ! Successful read - continue execution. : @@ -105,11 +102,11 @@ else end if ``` -There a second type of formatted output statement, the `write` +There is a second type of formatted output statement, the `write` statement: ```f90 -write (UNIT=nout, FMT="(10f10.3)", IOSTAT=ios) a +write (unit=nout, fmt="(10f10.3)", iostat=ios) a ``` ## Internal files @@ -121,11 +118,12 @@ itself. ```f90 integer, dimension(30) :: ival integer :: key -character(LEN=30) :: buffer -character(LEN=6), dimension(3), parameter :: form = (/"(30i1)", "(15i2)", "(10i3)"/) +character(len=30) :: buffer +character(len=6), dimension(3), parameter :: form = (/"(30i1)", & + "(15i2)", "(10i3)"/) -read (UNIT=*, FMT="(a30,i1)") buffer, key -read (UNIT=buffer, FMT=form(key)) ival(1:30 / key) +read (unit=*, fmt="(a30,i1)") buffer, key +read (unit=buffer, fmt=form(key)) ival(1:30 / key) ``` If an internal file is a scalar, it has a single record whose length is @@ -140,11 +138,11 @@ An example using a `write` statement is ```f90 integer :: day real :: cash -character(LEN=50) :: line +character(len=50) :: line : ! write into line -write (UNIT=line, FMT="(a, i2, a, f8.2, a)") "Takings for day ", day, & - & " are ", cash, " dollars" +write (unit=line, fmt="(a, i2, a, f8.2, a)") "Takings for day ", day, & + " are ", cash, " dollars" ``` that might write @@ -162,8 +160,8 @@ integer :: i real :: a complex, dimension(2) :: field logical :: flag -character(LEN=12) :: title -character(LEN=4) :: word +character(len=12) :: title +character(len=4) :: word : read *,i, a, field, flag, title, word ``` @@ -191,10 +189,10 @@ non-advancing I/O statement performs no such repositioning and may therefore leave the file positioned within a record. ```f90 -character(LEN=3) :: key +character(len=3) :: key integer :: u, s, ios : -read (UNIT=u, FMT="(a3)", ADVANCE="no", SIZE=s, IOSTAT=ios) key +read (unit=u, fmt="(a3)", advance="no", size=s, iostat=ios) key if (ios == 0) then : else @@ -212,8 +210,8 @@ next character position on the screen without an intervening line-feed, we can write ```f90 -write (UNIT=*, FMT="(a)", ADVANCE="no") "enter next prime number:" -read (UNIT=*, FMT="(i10)") prime_number +write (unit=*, fmt="(a)", advance="no") "enter next prime number:" +read (unit=*, fmt="(i10)") prime_number ``` Non-advancing I/O is for external files, and is not available for @@ -225,8 +223,8 @@ It is possible to specify that an edit descriptor be repeated a specified number of times, using a *repeat count*: `10f12.3` The slash edit descriptor (see -below) may have a repeat count, and a repeat count can +[below](control-edit-descriptors)) +may have a repeat count, and a repeat count can also apply to a group of edit descriptors, enclosed in parentheses, with nesting: @@ -258,9 +256,9 @@ computer or another computer using the same internal number representations: ```f90 -open (UNIT=4, FILE='test', FORM='unformatted') -read (UNIT=4) q -write (UNIT=nout, IOSTAT=ios) a ! no fmt= +open (unit=4, file='test', form='unformatted') +read (unit=4) q +write (unit=nout, iostat=ios) a ! no fmt= ``` ## Direct-access files @@ -276,21 +274,22 @@ real, dimension(length) :: a real, dimension(length + 1:2*length) :: b integer :: i, rec_length : -inquire (IOLENGTH=rec_length) a -open (UNIT=nunit, ACCESS="direct", RECL=rec_length, STATUS="scratch", ACTION="readwrite") +inquire (iolength=rec_length) a +open (unit=nunit, access="direct", recl=rec_length, status="scratch", & + action="readwrite") : ! Write array b to direct-access file in record 14 -write (UNIT=nunit, REC=14) b +write (unit=nunit, rec=14) b : ! Read the array back into array a -read (UNIT=nunit, REC=14) a +read (unit=nunit, rec=14) a do i = 1, length / 2 a(i) = i end do ! Replace modified record -write (UNIT=nunit, REC=14) a +write (unit=nunit, rec=14) a ``` The file must be an external file and list-directed formatting and diff --git a/source/learn/f95_features/expressions_and_assignments.md b/source/learn/f95_features/expressions_and_assignments.md index 7e21e4185189..487c1f1fb166 100644 --- a/source/learn/f95_features/expressions_and_assignments.md +++ b/source/learn/f95_features/expressions_and_assignments.md @@ -2,15 +2,15 @@ ## Scalar numeric -The usual arithmetic operators are available `+, -, *, /, **` (given -here in increasing order of precedence). +The usual arithmetic operators are available `+`, `-`, `*`, `/`, and +`**` (given here in increasing order of precedence). Parentheses are used to indicate the order of evaluation where necessary: ```f90 -a*b + c ! * first -a*(b + c) ! + first +a*b + c ! * first +a*(b + c) ! + first ``` The rules for *scalar numeric* expressions and assignments accommodate @@ -44,7 +44,7 @@ of real numbers to integers: For *scalar relational* operations of numeric types, there is a set of built-in operators: -`< <= == /= > >=` +`< <= == /= > >=` `.lt. .le. .eq. .ne. .gt. .ge.` (the forms above are new to Fortran-90, and older equivalent forms are @@ -57,12 +57,7 @@ flag = a == b ! for logical variable flags ### Scalar characters -In the case of *scalar characters* and given - -```f90 -character(8) result -``` - +In the case of *scalar characters* and given `character(8) result` it is legal to write ```f90 @@ -86,12 +81,12 @@ be (re)defined though: ```f90 type string80 - integer length - character(80) value + integer :: length + character(80) :: value end type string80 -character:: char1, char2, char3 -type(string80):: str1, str2, str3 +character :: char1, char2, char3 +type(string80) :: str1, str2, str3 ``` we can write @@ -123,7 +118,8 @@ procedures defining the operator and assignment, and corresponding operator-procedure association, as follows: ```f90 -interface operator(//) ! Overloads the // operator as invoking string_concat procedure +interface operator(//) ! Overloads the // operator as + ! invoking string_concat procedure module procedure string_concat end interface ``` @@ -143,7 +139,7 @@ module string_type type string80 integer length - character(LEN=80) :: string_data + character(len=80) :: string_data end type string80 interface assignment(=) @@ -156,31 +152,33 @@ module string_type contains subroutine c_to_s_assign(s, c) - type(string80), intent(OUT) :: s - character(LEN=*), intent(IN) :: c + type(string80), intent(out) :: s + character(LEN=*), intent(in) :: c s%string_data = c s%length = len(c) end subroutine c_to_s_assign subroutine s_to_c_assign(c, s) - type(string80), intent(IN) :: s - character(LEN=*), intent(OUT) :: c + type(string80), intent(in) :: s + character(len=*), intent(out) :: c c = s%string_data(1:s%length) end subroutine s_to_c_assign type(string80) function string_concat(s1, s2) - type(string80), intent(IN) :: s1, s2 + type(string80), intent(in) :: s1, s2 type(string80) :: s integer :: n1, n2 character(160) :: ctot n1 = len_trim(s1%string_data) n2 = len_trim(s2%string_data) + if (n1 + n2 <= 80) then s%string_data = s1%string_data(1:n1)//s2%string_data(1:n2) else ! This is an error condition which should be handled - for now just truncate ctot = s1%string_data(1:n1)//s2%string_data(1:n2) s%string_data = ctot(1:80) end if + s%length = len_trim(s%string_data) string_concat = s end function string_concat @@ -199,7 +197,7 @@ end program Defined operators such as these are required for the expressions that are allowed also in structure constructors (see -[Derived-data types](Derived-data_types): +[Derived-data types](derived-data-types)): ```f90 str1 = string(2, char1//char2) ! structure constructor @@ -214,7 +212,7 @@ way, on an element-by-element basis. For example, given declarations of ```f90 real, dimension(10, 20) :: a, b, c real, dimension(5) :: v, w -logical flag(10, 20) +logical :: flag(10, 20) ``` it can be written: @@ -249,7 +247,7 @@ are - `scale` - `set_exponent` -These are array valued for array arguments (elemental), like all +These are array valued for array arguments (`elemental`), like all [FORTRAN 77](https://en.wikipedia.org/wiki/FORTRAN_77) functions (except `len`): @@ -266,7 +264,7 @@ functions (except `len`): - `max` - `min` -Powers, logarithms, and trigonometric functions +Powers, logarithms, and trigonometric functions: - `sqrt` - `exp` diff --git a/source/learn/f95_features/f95_features.md b/source/learn/f95_features/f95_features.md deleted file mode 100644 index 679b623a8190..000000000000 --- a/source/learn/f95_features/f95_features.md +++ /dev/null @@ -1,413 +0,0 @@ -## Data transfer - -### Formatted input/output - -These examples illustrate various forms of I/O lists with some simple -formats (see -below): - -```f90 -INTEGER :: i -REAL, DIMENSION(10) :: a -CHARACTER(len=20) :: word -PRINT "(i10)", i -PRINT "(10f10.3)", a -PRINT "(3f10.3)", a(1),a(2),a(3) -PRINT "(a10)", word(5:14) -PRINT "(3f10.3)", a(1)*a(2)+i, SQRT(a(3:4)) -``` - -Variables, but not expressions, are equally valid in input statements -using the `READ` statement: - -```f90 -READ "(i10)", i -``` - -If an array appears as an item, it is treated as if the elements were -specified in array element order. - -Any pointers in an I/O list must be associated with a target, and -transfer takes place between the file and the targets. - -An item of derived type is treated as if the components were specified -in the same order as in the type declaration, so - -```f90 -read "(8f10.5)", p, t ! types point and triangle -``` - -has the same effect as the statement - -```f90 -READ "(8f10.5)", p%x, p%y, t%a%x, t%a%y, t%b%x, & - t%b%y, t%c%x, t%c%y -``` - -An object in an I/O list is not permitted to be of a derived type that -has a pointer component at any level of component selection. - -Note that a zero-sized array may occur as an item in an I/O list. Such -an item corresponds to no actual data transfer. - -The format specification may also be given in the form of a character -expression: - -```f90 -CHARACTER(len=*), parameter :: form = "(f10.3)" -: -PRINT form, q -``` - -or as an asterisk this is a type of I/O known as *list-directed* I/O -(see -below), -in which the format is defined by the computer system: - -```f90 -PRINT *, "Square-root of q = ", SQRT(q) -``` - -Input/output operations are used to transfer data between the storage of -an executing program and an external medium, specified by a *unit -number*. However, two I/O statements, `PRINT` and a variant of `READ`, -do not reference any unit number: this is referred to as terminal I/O. -Otherwise the form is: - -```f90 -READ (UNIT=4, FMT="(f10.3)") q -READ (UNIT=nunit, FMT="(f10.3)") q -READ (UNIT=4*i+j, FMT="(f10.3)") a -``` - -where `UNIT=` is optional. The value may be any nonnegative integer -allowed by the system for this purpose (but 0, 5 and 6 often denote the -error, keyboard and terminal, respectively). - -An asterisk is a variantagain from the keyboard: - -```f90 -READ (UNIT=*, FMT="(f10.3)") q -``` - -A read with a unit specifier allows -exception handling: - -```f90 -READ (UNIT=NUNIT, FMT="(3f10.3)", IOSTAT=ios) a,b,c -IF (ios == 0) THEN -! Successful read - continue execution. - : -ELSE -! Error condition - take appropriate action. - CALL error (ios) -END IF -``` - -There a second type of formatted output statement, the `WRITE` -statement: - -```f90 -WRITE (UNIT=nout, FMT="(10f10.3)", IOSTAT=ios) a -``` - -### Internal files - -These allow format conversion between various representations to be -carried out by the program in a storage area defined within the program -itself. - -```f90 -INTEGER, DIMENSION(30) :: ival -INTEGER :: key -CHARACTER(LEN=30) :: buffer -CHARACTER(LEN=6), DIMENSION(3), PARAMETER :: form = (/ "(30i1)", "(15i2)","(10i3)" /) -READ (UNIT=*, FMT="(a30,i1)") buffer, key -READ (UNIT=buffer, FMT=form(key)) ival(1:30/key) -``` - -If an internal file is a scalar, it has a single record whose length is -that of the scalar. - -If it is an array, its elements, in array element order, are treated as -successive records of the file and each has length that of an array -element. - -An example using a `WRITE` statement is - -```f90 -INTEGER :: day -REAL :: cash -CHARACTER(LEN=50) :: line -: -! write into line -WRITE (UNIT=line, FMT="(a, i2, a, f8.2, a)") "Takings for day ", day, " are ", cash, " dollars" -``` - -that might write - - Takings for day 3 are 4329.15 dollars - -### List-directed I/O - -An example of a read without a specified format for input is - -```f90 -INTEGER :: i -REAL :: a -COMPLEX, DIMENSION(2) :: field -LOGICAL :: flag -CHARACTER(LEN=12) :: title -CHARACTER(LEN=4) :: word -: -READ *, i, a, field, flag, title, word -``` - -If this reads the input record - -```f90 -10 6.4 (1.0,0.0) (2.0,0.0) t test/ -``` - -(in which blanks are used as separators), then `i`, `a`, `field`, -`flag`, and `title` will acquire the values 10, 6.4, (1.0,0.0) and -(2.0,0.0), `.true.` and `test` respectively, while `word` remains -unchanged. - -Quotation marks or apostrophes are required as delimiters for a string -that contains a blank. - -### Non-advancing I/O - -This is a form of reading and writing without always advancing the file -position to ahead of the next record. Whereas an advancing I/O statement -always repositions the file after the last record accessed, a -non-advancing I/O statement performs no such repositioning and may -therefore leave the file positioned within a record. - -```f90 -CHARACTER(LEN=3) :: key -INTEGER :: u, s, ios -: -READ(UNIT=u, FMT="(a3)", ADVANCE="no", SIZE=s, IOSTAT=ios) key -IF (ios == 0) THEN - : -ELSE -! key is not in one record - key(s+1:) = "" - : -END IF -``` - -A non-advancing read might read the first few characters of a record and -a normal read the remainder. - -In order to write a prompt to a terminal screen and to read from the -next character position on the screen without an intervening line-feed, -we can write - -```f90 -WRITE (UNIT=*, FMT="(a)", ADVANCE="no") "enter next prime number:" -READ (UNIT=*, FMT="(i10)") prime_number -``` - -Non-advancing I/O is for external files, and is not available for -list-directed I/O. - -### Edit descriptors - -It is possible to specify that an edit descriptor be repeated a -specified number of times, using a *repeat count*: `10f12.3` - -The slash edit descriptor (see -below) may have a repeat count, and a repeat count can -also apply to a group of edit descriptors, enclosed in parentheses, with -nesting: - -```f90 -PRINT "(2(2i5,2f8.2))", i(1),i(2),a(1),a(2), i(3),i(4),a(3),a(4) -``` - -Entire format specifications can be repeated: - -```f90 -PRINT "(10i8)", (/ (i(j), j=1,200) /) -``` - -writes 10 integers, each occupying 8 character positions, on each of 20 -lines (repeating the format specification advances to the next line). - -#### Data edit descriptors - -#### Control edit descriptors - -*Control edit descriptors setting conditions*: *Control edit descriptors -for immediate processing*: - -### Unformatted I/O - -This type of I/O should be used only in cases where the records are -generated by a program on one computer, to be read back on the same -computer or another computer using the same internal number -representations: - -```f90 -OPEN(UNIT=4, FILE='test', FORM='unformatted') -READ(UNIT=4) q -WRITE(UNIT=nout, IOSTAT=ios) a ! no fmt= -``` - -### Direct-access files - -This form of I/O is also known as random access or indexed I/O. Here, -all the records have the same length, and each record is identified by -an index number. It is possible to write, read, or re-write any -specified record without regard to position. - -```f90 -INTEGER, PARAMETER :: nunit=2, length=100 -REAL, DIMENSION(length) :: a -REAL, DIMENSION(length+1:2*length) :: b -INTEGER :: i, rec_length -: -INQUIRE (IOLENGTH=rec_length) a -OPEN (UNIT=nunit, ACCESS="direct", RECL=rec_length, STATUS="scratch", ACTION="readwrite") -: -! Write array b to direct-access file in record 14 -WRITE (UNIT=nunit, REC=14) b -: -! -! Read the array back into array a -READ (UNIT=nunit, REC=14) a -: -DO i = 1, length/2 - a(i) = i -END DO -! -! Replace modified record -WRITE (UNIT=nunit, REC=14) a -``` - -The file must be an external file and list-directed formatting and -non-advancing I/O are unavailable. - - -## Operations on external files - -Once again, this is an overview only. - -### File positioning statements - -### The `OPEN` statement - -The statement is used to connect an external file to a unit, create a -file that is preconnected, or create a file and connect it to a unit. -The syntax is - -```f90 -OPEN (UNIT=u, STATUS=st, ACTION=act [,olist]) -``` - -where `olist` is a list of optional specifiers. The specifiers may -appear in any order. - -```f90 -OPEN (UNIT=2, IOSTAT=ios, FILE="cities", STATUS="new", ACCESS="direct", & - ACTION="readwrite", RECL=100) -``` - -Other specifiers are `FORM` and `POSITION`. - -### The `CLOSE` statement - -This is used to disconnect a file from a unit. - -```f90 -CLOSE (UNIT=u [, IOSTAT=ios] [, STATUS=st]) -``` - -as in - -```f90 -CLOSE (UNIT=2, IOSTAT=ios, STATUS="delete") -``` - -### The `inquire` statement - -At any time during the execution of a program it is possible to inquire -about the status and attributes of a file using this statement. - -Using a variant of this statement, it is similarly possible to determine -the status of a unit, for instance whether the unit number exists for -that system. - -Another variant permits an inquiry about the length of an output list -when used to write an unformatted record. - -For inquire by unit - -```f90 -INQUIRE (UNIT=u, ilist) -``` - -or for inquire by file - -```f90 -INQUIRE (FILE=fln, ilist) -``` - -or for inquire by I/O list - -```f90 -INQUIRE (IOLENGTH=length) olist -``` - -As an example - -```f90 -LOGICAL :: ex, op -CHARACTER (LEN=11) :: nam, acc, seq, frm -INTEGER :: irec, nr -INQUIRE (UNIT=2, EXIST=ex, OPENED=op, NAME=nam, ACCESS=acc, SEQUENTIAL=seq, & - FORM=frm, RECL=irec, NEXTREC=nr) -``` - -yields - -```f90 -ex .true. -op .true. -nam cities -acc DIRECT -seq NO -frm UNFORMATTED -irec 100 -nr 1 -``` - -(assuming no intervening read or write operations). - -Other specifiers are -`IOSTAT, OPENED, NUMBER, NAMED, FORMATTED, POSITION, ACTION, READ, WRITE, READWRITE`. - -```mediawiki -==References== -{{Reflist}} -=== Bibliography === -{{refbegin}} -* {{Citation |last=Metcalf |first=Michael |title=Whence Fortran? |date=2004-06-17 |work=Fortran 95/2003 Explained |pages=1–8 |url=https://doi.org/10.1093/oso/9780198526926.003.0001 |access-date=2025-02-25 |publisher=Oxford University PressOxford |isbn=978-0-19-852692-6 |last2=Reid |first2=John |last3=Cohen |first3=Malcolm}} -* {{Citation |title=Introduction to Modern Fortran |work=Statistics and Computing |pages=13–53 |url=https://doi.org/10.1007/0-387-28123-1_2 |access-date=2025-02-25 |place=New York |publisher=Springer-Verlag |isbn=0-387-23817-4}} -* {{Cite journal |last=Gehrke |first=Wilhelm |date=1996 |title=Fortran 95 Language Guide |url=https://doi.org/10.1007/978-1-4471-1025-5 |doi=10.1007/978-1-4471-1025-5}} -* {{Citation |last=Chivers |first=Ian |title=Fortran 2000 and Various Fortran Dialects |date=2000 |work=Introducing Fortran 95 |pages=377–388 |url=https://doi.org/10.1007/978-1-4471-0403-2_29 |access-date=2025-02-25 |place=London |publisher=Springer London |isbn=978-1-85233-276-1 |last2=Sleightholme |first2=Jane}} -* {{cite book|title=Fortran 95|author1-first=Martin|author1-last=Counihan|edition=2nd|publisher=CRC Press|year=2006|isbn=9780203978467}} -* {{cite book|title=Computer programming in FORTRAN 90 and 95|author1-first=V.|author1-last=Ramaraman|publisher=PHI Learning Pvt. Ltd.|year=1997|isbn=9788120311817}} -* {{cite book|title=Modern Fortran Explained: Incorporating Fortran 2023|author1-first=Michael|author1-last=Metcalf|author2-first=John|author2-last=Reid|author3-first=Malcolm|author3-last=Cohen|author4-first=Reinhold|author4-last=Bader|edition=6th|publisher=Oxford University Press|year=2024|isbn=9780198876595}} -* {{cite book|title=An Introduction to Fortran 90/95: Syntax and Programming|author1-first=Yogendra Prasad|author1-last=Joshi|publisher=Allied Publishers|isbn=9788177644746}} -{{refend}} -{{Authority control}} - -{{DEFAULTSORT:Fortran Language Features}} -[[Category:Fortran|Features]] -``` diff --git a/source/learn/f95_features/index.md b/source/learn/f95_features/index.md index 58ed0b5870d9..7e8e1e099c8f 100644 --- a/source/learn/f95_features/index.md +++ b/source/learn/f95_features/index.md @@ -11,6 +11,8 @@ Array handling Pointers Intrinsic procedures Data transfer +Operations on external files +Bibliography ::: This is an overview of **Fortran 95 language features** which is based @@ -25,11 +27,12 @@ The additional features of subsequent standards, up to Fortran 2023, are described in the Fortran 2023 standard document, ISO/IEC 1539-1:2023.[^iso_1539_2023] Some of its new features are still being implemented in compilers.[^Fortran_plus] Details can also be found in a -range of textbooks, for instance[^OOPvF][^OOPC][^Chapman] and see the\ +range of textbooks, for instance[^OOPvF][^OOPC][^Chapman] and see the list at Fortran Resources.[^Fortran_plus_18] Sources for the description in the sections below can be found in the standards documents,[^iso_1539_2023] textbooks[^OOPvF][^OOPC][^Chapman] as well as -the **Bibliography**. +the +[bibliography](bibliography). The booklet is based on Wikipedia's article [Fortran 95 language @@ -68,4 +71,4 @@ last edit by February 25, 2025 16:08 UTC. [^Fortran_plus_18]: [Fortranplus | Fortran information](http://www.fortranplus.co.uk/fortran-information/), -p. 18 + p. 18 diff --git a/source/learn/f95_features/intrinsic_procedures.md b/source/learn/f95_features/intrinsic_procedures.md index cfba9f81c59d..37b41bcfb96d 100644 --- a/source/learn/f95_features/intrinsic_procedures.md +++ b/source/learn/f95_features/intrinsic_procedures.md @@ -24,22 +24,24 @@ The procedures not already introduced are Bit inquiry -| `bit_size` | Number of bits in the model | -|------------|-----------------------------| +```{csv-table} +`bit_size`, "Number of bits in the model" +``` Bit manipulation -| `btest` | Bit testing | -|----------|--------------------| -| `iand` | Logical AND | -| `ibclr` | Clear bit | -| `ibits` | Bit extraction | -| `ibset` | Set bit | -| `ieor` | Exclusive OR | -| `ior` | Inclusive OR | -| `ishft` | Logical shift | -| `ishftc` | Circular shift | -| `not` | Logical complement | +```{csv-table} +`btest`, "Bit testing" +`iand`, "Logical AND" +`ibclr`, "Clear bit" +`ibits`, "Bit extraction" +`ibset`, "Set bit" +`ieor`, "Exclusive OR" +`ior`, "Inclusive OR" +`ishft`, "Logical shift" +`ishftc`, "Circular shift" +`not`, "Logical complement" +``` Transfer function, as in @@ -51,10 +53,11 @@ integer :: i = transfer('abcd', 0) Subroutines -| `date_and_time` | Obtain date and/or time | -|-----------------|-----------------------------------| -| `mvbits` | Copies bits | -| `random_number` | Returns pseudorandom numbers | -| `random_seed` | Access to seed | -| `system_clock` | Access to system clock | -| `cpu_time` | Returns processor time in seconds | +```{csv-table} +`date_and_time`, "Obtain date and/or time" +`mvbits`, "Copies bits" +`random_number`, "Returns pseudorandom numbers" +`random_seed`, "Access to seed" +`system_clock`, "Access to system clock" +`cpu_time`, "Returns processor time in seconds" +``` diff --git a/source/learn/f95_features/language_elements.md b/source/learn/f95_features/language_elements.md index c986e900466d..00c89bcb1ae0 100644 --- a/source/learn/f95_features/language_elements.md +++ b/source/learn/f95_features/language_elements.md @@ -27,13 +27,14 @@ that have a syntactic meaning to the compiler are built from those components. There are six classes of tokens: -| Label | `123` | -|-----------|------------------------------------------------------| -| Constant | `123.456789_long` | -| Keyword | `allocatable` | -| Operator | `.add.` | -| Name | `solve_equation` (up to 31 characters, including \_) | -| Separator | `/ ( ) (/ /) [ ] , = => : :: ; %` | +```{csv-table} +Label, "`123`" +Constant, "`123.456789_long`" +Keyword, "`allocatable`" +Operator, "`.add.`" +Name, "`solve_equation` (up to 31 characters, including \_)" +Separator, "`/ ( ) (/ /) [ ] , = => : :: ; %`" +``` From the tokens, [statements](https://en.wikipedia.org/wiki/Statement_(programming)) @@ -43,8 +44,8 @@ column structure: ```f90 function string_concat(s1, s2) ! This is a comment - type(string), intent(IN) :: s1, s2 - type(string) string_concat + type(string), intent(in) :: s1, s2 + type(string) :: string_concat string_concat%string_data = s1%string_data(1:s1%length) // & s2%string_data(1:s2%length) ! This is a continuation string_concat%length = s1%length + s2%length @@ -107,7 +108,8 @@ that allows subsequent definition of constants of the form ``` Here, `two_bytes` is the kind type parameter; it can also be an explicit -default integer literal constant, like `-1234_2` but such use is non-portable. +default integer literal constant, like `-1234_2` but such use is +non-portable. The `kind` function supplies the value of a kind type parameter: @@ -124,9 +126,8 @@ range(1_two_bytes) Also, in [`data` (initialization) statements](data_statement), -binary (B), octal (O) and hexadecimal -(Z) constants may be used (often informally referred to as "BOZ -constants"): +binary (`B`), octal (`O`) and hexadecimal (`Z`) constants +may be used (often informally referred to as "BOZ constants"): ```f90 B'01010101' O'01234567' Z'10fa' @@ -198,7 +199,7 @@ but not widely supported by compilers. Again, the kind value is given by the `kind` function: ```f90 -KIND('ASCII') +kind('ASCII') ``` ### Number model and intrinsic functions @@ -208,16 +209,17 @@ functions (whose values are independent of the values of their arguments; arguments are used only to provide kind). These functions are important for portable numerical software: -| `digits(x)` | Number of significant digits | -|------------------|------------------------------------------| -| `epsilon(x)` | Almost negligible compared to one (real) | -| `huge(x)` | Largest number | -| `maxexponent(x)` | Maximum model exponent (real) | -| `minexponent(x)` | Minimum model exponent (real) | -| `precision(x)` | Decimal precision (real, complex) | -| `radix(x)` | Base of the model | -| `range(x)` | Decimal exponent range | -| `tiny(x)` | Smallest positive number (real) | +```{csv-table} +`digits(x)`, "Number of significant digits" +`epsilon(x)`, "Almost negligible compared to one (real)" +`huge(x)`, "Largest number" +`maxexponent(x)`, "Maximum model exponent (real)" +`minexponent(x)`, "Minimum model exponent (real)" +`precision(x)`, "Decimal precision (real, complex)" +`radix(x)`, "Base of the model" +`range(x)`, "Decimal exponent range" +`tiny(x)`, "Smallest positive number (real)" +``` ## Scalar variables @@ -244,12 +246,12 @@ While it is not required in above examples (as there are no additional attributes and initialization), most Fortran-90 programmers acquire the habit to use it everywhere. -The `len=` specifier is applicable only to `character`s and specifies the string -length (replacing the older `*len` form). The explicit `kind=` and -`len=` specifiers are optional: +The `len=` specifier is applicable only to `character`s and specifies +the string length (replacing the older `*len` form). The explicit +`kind=` and `len=` specifiers are optional: ```f90 -CHARACTER(2, Kanji) :: kanji_word +character(2, kanji) :: kanji_word ``` works just as well. @@ -259,7 +261,7 @@ as in ```f90 character(80) :: line -... = line(i:i) ! substring +... = line(i:i) ! substring ``` was previously possible, so now is the substring @@ -271,17 +273,18 @@ was previously possible, so now is the substring Also, zero-length strings are allowed: ```f90 -line(i:i-1) ! zero-length string +line(i:i-1) ! zero-length string ``` Finally, there is a set of intrinsic character functions, examples being -| `achar` | `iachar` (for ASCII set) | -|------------|------------------------------| -| `adjustl` | `adjustr` | -| `len_trim` | `index(s1, s2, back=.true.)` | -| `repeat` | `scan`(for one of a set) | -| `trim` | `verify`(for all of a set) | +```{csv-table} +`achar`, "`iachar` (for ASCII set)" +`adjustl`, "`adjustr`" +`len_trim`, "`index(s1, s2, back=.true.)`" +`repeat`, "`scan`(for one of a set)" +`trim`, "`verify`(for all of a set)" +``` ## Derived data types @@ -289,15 +292,15 @@ For derived data types, the form of the type must be defined first: ```f90 type person - character(10) name - real age + character(10) :: name + real :: age end type person ``` and then, variables of that type can be defined: ```f90 -type(person) you, me +type(person) :: you, me ``` To select components of a derived type, `%` qualifier is used: @@ -318,17 +321,18 @@ previously defined type: ```f90 type point - real x, y + real :: x, y end type point + type triangle - type(point) a, b, c + type(point) :: a, b, c end type triangle ``` and for a variable of `type triangle`, as in ```f90 -type(triangle) t +type(triangle) :: t ``` each component of type `point` is accessed as @@ -340,19 +344,20 @@ t%a t%b t%c which, in turn, have ultimate components of `type real`: ```f90 -t%a%x t%a%y t%b%x etc. +t%a%x t%a%y t%b% ``` -(Note that the `%` qualifier was chosen rather than dot (`.`) because of -potential ambiguity with operator notation, like `.OR.`). +etc. (Note that the `%` qualifier was chosen rather than dot (`.`) +because of potential ambiguity with operator notation, like `.OR.`). ## Implicit and explicit typing -Unless specified otherwise, all variables starting with letters `i`, `j`, `k`, -`l`, `m` and `n`are default `integer`s, and all others are default `real`; +Unless specified otherwise, all variables starting with letters `i`, +`j`, `k`, `l`, `m` and `n` default to `integer`, and all others are +default `real`; other data types must be explicitly declared. This is known as *implicit typing* and is a heritage of early FORTRAN days. Those defaults can be -overridden by *`IMPLICIT TypeName (CharacterRange)`* statements, like: +overridden by `implicit TypeName (CharacterRange)` statements, like: ```f90 implicit complex(z) @@ -361,13 +366,8 @@ implicit real(c-h,n-y) ``` However, it is a good practice to explicitly type all variables, and -this can be forced by inserting the statement - -```f90 -implicit none -``` - -at the beginning of each program unit. +this can be forced by inserting the statement `implicit none` at the +beginning of each program unit. ## Arrays @@ -382,7 +382,7 @@ optional and considered an attribute; if omitted, the array shape must be specified after array-variable name. For example, ```f90 -real:: a(10) +real :: a(10) integer, dimension(0:100, -50:50) :: map ``` @@ -399,10 +399,10 @@ and are scalars. The subscripts may be any scalar integer expression. *Sections* are parts of the array variables, and are arrays themselves: ```f90 -a(i:j) ! rank one -map(i:j, k:l:m) ! rank two -a(map(i, k:l)) ! vector subscript -a(3:2) ! zero length +a(i:j) ! rank one +map(i:j, k:l:m) ! rank two +a(map(i, k:l)) ! vector subscript +a(3:2) ! zero length ``` Whole arrays and array sections are array-valued objects. Array-valued @@ -464,10 +464,10 @@ This declaration is equivalent to real, dimension(3), save :: point = (/0.0, 1.0, -1.0/) ``` -for local variables within a subroutine or function. The SAVE attribute -causes local variables to retain their value after a procedure call and -then to initialize the variable to the saved value upon returning to the -procedure. +for local variables within a subroutine or function. The `save` +attribute causes local variables to retain their value after a procedure +call and then to initialize the variable to the saved value upon +returning to the procedure. ### `parameter` attribute @@ -476,9 +476,9 @@ attribute and the constant values to a type statement: ```f90 real, dimension(3), parameter :: field = (/0., 1., 2./) -type(triplet), parameter :: t = triplet((/0., 0., 0./)) +type(triplet), parameter :: t = triplet((/0., 0., 0./)) ``` - +(data_statement)= ### `data` statement The `data` statement can be used for scalars and also for arrays and @@ -499,13 +499,13 @@ The values used in `data` and `parameter` statements, or with these attributes, are constant expressions that may include references to: array and structure constructors, elemental intrinsic functions with integer or character arguments and results, and the six transformational -functions `repeat, selected_int_kind, trim, selected_real_kind, reshape` -and `transfer` (see -[Intrinsic procedures](intrinsic_procedures): +functions `repeat`, `selected_int_kind`, `trim`, `selected_real_kind`, +`reshape`, and `transfer` (see +[Intrinsic procedures](intrinsic_procedures)): ```f90 integer, parameter :: long = selected_real_kind(12), & - array(3) = (/1, 2, 3/) + array(3) = (/1, 2, 3/) ``` ## Specification expressions @@ -520,8 +520,8 @@ subroutine s(b, m, c) real, dimension(:, :) :: b real, dimension(ubound(b, 1) + 5) :: x integer :: m - character(LEN=*) :: c - character(LEN=m + len(c)) :: cc + character(len=*) :: c + character(len=m + len(c)) :: cc real(selected_real_kind(2*precision(a))) :: z end subroutine ``` diff --git a/source/learn/f95_features/operations_on_external_files.md b/source/learn/f95_features/operations_on_external_files.md new file mode 100644 index 000000000000..7aa8f16b8d0b --- /dev/null +++ b/source/learn/f95_features/operations_on_external_files.md @@ -0,0 +1,98 @@ +# Operations on external files + +Once again, this is an overview only. + +## File positioning statements + +## The `open` statement + +The statement is used to connect an external file to a unit, create a +file that is preconnected, or create a file and connect it to a unit. +The syntax is + +```f90 +open (unit=u, status=st, action=act[, olist]) +``` + +where `olist` is a list of optional specifiers. The specifiers may +appear in any order. + +```f90 +open (unit=2, iostat=ios, file="cities", status="new", access="direct", & + action="readwrite", recl=100) +``` + +Other specifiers are `form` and `position`. + +## The `close` statement + +This is used to disconnect a file from a unit. + +```f90 +close (unit=u[, iostat=ios] [, status=st]) +``` + +as in + +```f90 +close (unit=2, iostat=ios, status="delete") +``` + +## The `inquire` statement + +At any time during the execution of a program it is possible to inquire +about the status and attributes of a file using this statement. + +Using a variant of this statement, it is similarly possible to determine +the status of a unit, for instance whether the unit number exists for +that system. + +Another variant permits an inquiry about the length of an output list +when used to write an unformatted record. + +For inquire by unit + +```f90 +inquire (unit=u, ilist) +``` + +or for inquire by file + +```f90 +inquire (file=fln, ilist) +``` + +or for inquire by I/O list + +```f90 +inquire (iolength=length) olist +``` + +As an example + +```f90 +logical :: ex, op +character(len=11) :: nam, acc, seq, frm +integer :: irec, nr +inquire (unit=2, exist=ex, opened=op, name=nam, access=acc, sequential=seq, & + form=frm, recl=irec, nextrec=nr) +``` + +yields + +```f90 +ex .true. +op .true. +nam cities +acc direct +seq no +frm unformatted +irec 100 +nr 1 +``` + +(assuming no intervening read or write operations). + +Other specifiers are +`iostat`, `opened`, `number`, `named`, `formatted`, `position`, `action`, +`read`, `write`, `readwrite`. diff --git a/source/learn/f95_features/pointers.md b/source/learn/f95_features/pointers.md index 284fafab8e3f..d487d8a2dccd 100644 --- a/source/learn/f95_features/pointers.md +++ b/source/learn/f95_features/pointers.md @@ -13,7 +13,7 @@ They are conceptually a descriptor listing the attributes of the objects (targets) that the pointer may point to, and the address, if any, of a target. They have no associated storage until it is allocated or otherwise associated (by pointer assignment, see -[Pointers in expressions and assignments](Pointers_in_expressions_and_assignments): +[Pointers in expressions and assignments](pointers_in_expressions_and_assignments)): ```f90 allocate (var) @@ -59,7 +59,7 @@ A pointer can be a component of a derived type: ```f90 type entry ! type for sparse matrix - real :: value + real :: value integer :: index type(entry), pointer :: next ! note recursion end type entry @@ -122,7 +122,7 @@ by other means): ```f90 real, target :: b(10, 10), c(10, 10), r(10), s(10), z(10) real, pointer :: a(:, :), x(:), y(:) -integer mult +integer :: mult : do mult = 1, 2 if (mult == 1) then @@ -195,23 +195,23 @@ in ```f90 use data_handler -real x(100) +real :: x(100) real, pointer :: y(:) : y => compact(x) ``` -where the module data_handler contains +where the module `data_handler` contains ```f90 function compact(x) real, pointer :: compact(:) - real x(:) + real :: x(:) ! A procedure to remove duplicates from the array x integer n - : ! Find the number of distinct values, n + : ! Find the number of distinct values, n allocate (compact(n)) - : ! Copy the distinct values into compact + : ! Copy the distinct values into compact end function compact ``` @@ -282,7 +282,7 @@ table(m:n, p:q) these references may be replaced by ```f90 -REAL, DIMENSION(:, :), POINTER :: window +real, dimension(:, :), pointer :: window : window => table(m:n, p:q) ``` @@ -318,8 +318,8 @@ shape array dummy arguments): ```f90 function remap_bounds2(lb1, lb2, array) result(ptr) - integer, intent(IN) :: lb1, lb2 - real, dimension(lb1:, lb2:), intent(IN), target :: array + integer, intent(in) :: lb1, lb2 + real, dimension(lb1:, lb2:), intent(in), target :: array real, dimension(:, :), pointer :: ptr ptr => array end function diff --git a/source/learn/f95_features/program_units_and_procedures.md b/source/learn/f95_features/program_units_and_procedures.md index 8d76bd3c0a7e..aaa19179f789 100644 --- a/source/learn/f95_features/program_units_and_procedures.md +++ b/source/learn/f95_features/program_units_and_procedures.md @@ -44,11 +44,7 @@ function name(arg1, arg2) ! zero or more arguments end function name ``` -The form of reference of a function is - -```f90 -x = name(a, b) -``` +The form of reference of a function is `x = name(a, b)`. ## Internal procedures @@ -80,16 +76,17 @@ The names of program units and external procedures are *global*, and the names of implied-DO variables have a scope of the statement that contains them. +(modules)= ## Modules Modules are used to package -- global data (replaces COMMON and BLOCK DATA from Fortran 77); +- global data (replaces `COMMON` and `BLOCK DATA` from FORTRAN 77); - type definitions (themselves a scoping unit); -- subprograms (which among other things replaces the use of ENTRY from - Fortran 77); +- subprograms (which among other things replaces the use of `ENTRY` from + FORTRAN 77); - interface blocks (another scoping unit, see - [Interface blocks](interface_blocks); + [Interface blocks](interface-blocks)); - namelist groups (see any textbook). An example of a module containing a type definition, interface block and @@ -151,9 +148,10 @@ public :: only_this ``` For derived types there are three possibilities: the type and its -components are all `public`, the type is `public` and its components `private` -(the type only is visible and one can change its details easily), or all -of it is `private` (for internal use in the module only): +components are all `public`, the type is `public` and its components +`private` (the type only is visible and one can change its details +easily), or all of it is `private` (for internal use in the module +only): ```f90 module mine @@ -193,17 +191,18 @@ We may specify the intent of dummy arguments: ```f90 subroutine shuffle(ncards, cards) - integer, intent(IN) :: ncards - integer, intent(OUT), dimension(ncards) :: cards + integer, intent(in) :: ncards + integer, intent(out), dimension(ncards) :: cards ``` -Also, `INOUT` is possible: here the actual argument must be a variable +Also, `inout` is possible: here the actual argument must be a variable (unlike the default case where it may be a constant). Arguments may be optional: ```f90 -subroutine mincon(n, f, x, upper, lower, equalities, inequalities, convex, xstart) +subroutine mincon(n, f, x, upper, lower, equalities, inequalities, & + convex, xstart) real, optional, dimension :: upper, lower : if (present(lower)) then ! test for presence of actual argument @@ -232,7 +231,7 @@ interface that is 'explicit' (that is, the compiler can see all the details). A reference to an external (or dummy) procedure is usually 'implicit' (the compiler assumes the details). However, we can provide an explicit interface in this case too. It is a copy of the header, -specifications and END statement of the procedure concerned, either +specifications and `end` statement of the procedure concerned, either placed in a module or inserted directly: ```f90 @@ -242,7 +241,7 @@ real function minimum(a, b, func) real, intent(in) :: a, b interface real function func(x) - real, intent(IN) :: x + real, intent(in) :: x end function func end interface real f, x @@ -256,10 +255,10 @@ An explicit interface is obligatory for - optional and keyword arguments; - `pointer` and `target` arguments (see - [Pointers](Pointers); + [Pointers](pointers)); - `pointer` function result; - new-style array arguments and array functions - ([Array handling](Array_handling)). + ([Array handling](array_handling)). It allows full checks at compile time between actual and dummy arguments. @@ -299,7 +298,7 @@ correct association. We have already seen the use of interface blocks for defined operators and assignment (see -[Modules](Modules). +[Modules](Modules)). ## Recursion @@ -320,7 +319,7 @@ recursive function integrate(f, bounds) real f, x end function f end interface - real, dimension(2), intent(IN) :: bounds + real, dimension(2), intent(in) :: bounds : end function integrate ``` @@ -356,7 +355,7 @@ Here, we note the `result` clause and termination test. This is a feature for parallel computing. In -[the `forall` statement and construct](forall_statement_and_construct), +[the `forall` statement and construct](forall-statement), any side effects in a function can impede optimization on a parallel processor the order of execution of the assignments could affect the results. To control this situation, we add the `pure` keyword From e4ba981ec708a9d28a7c1f2399bbb5439d220bff Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Thu, 27 Mar 2025 22:11:14 +0100 Subject: [PATCH 09/10] detailed revision Markdown files were edited for a more readable syntax; the cross-referencing to other sections of the same, or other Markdown files revised (and checked with the `#build_preview` robot provide by https://github.com/fortran-lang/webpage/). This squashes multiple (iterative) individual commits into a single one. Signed-off-by: Norwid Behrnd --- source/learn/f95_features/array_handling.md | 46 +++++++------------ source/learn/f95_features/data_transfer.md | 15 +++--- .../expressions_and_assignments.md | 10 ++-- .../learn/f95_features/language_elements.md | 4 +- source/learn/f95_features/pointers.md | 6 ++- .../program_units_and_procedures.md | 13 +++--- 6 files changed, 44 insertions(+), 50 deletions(-) diff --git a/source/learn/f95_features/array_handling.md b/source/learn/f95_features/array_handling.md index 72c9abf32b12..a364e37fd266 100644 --- a/source/learn/f95_features/array_handling.md +++ b/source/learn/f95_features/array_handling.md @@ -10,10 +10,11 @@ Array handling is included in Fortran for two main reasons: At the same time, major extensions of the functionality in this area have been added. We have already met whole arrays above -#Arrays 1 and -here -#Arrays 2 - -now we develop the theme. +(see corresponding sections in +[Language elements](language_elements.md#arrays) +and +[Expressions and assignments](expressions_and_assignments.md#arrays)) +and continue to develop the theme. ## Zero-sized arrays @@ -52,7 +53,7 @@ call sub(a) the corresponding dummy argument specification defines only the type and rank of the array, not its shape. This information has to be made available by an explicit interface, often using an interface block (see -[Interface blocks](interface_blocks)). +[Interface blocks](program_units_and_procedures.md#interface-blocks)). Thus we write just ```f90 @@ -168,10 +169,12 @@ end subroutine swap ``` The dummy arguments cannot be used in specification expressions (see -above) except as arguments to certain intrinsic -functions (`bit_size`, `kind`, `len`, and the numeric inquiry ones, (see -below). +[Specification expressions](language_elements.md#specification-expressions) +mentioned earlier in Language elements) +except as arguments to certain intrinsic +functions (`bit_size`, `kind`, `len`, and the numeric inquiry ones (see +[Intrinsic data types](language_elements.md#intrinsic-data-types), +and below). ## `where` @@ -289,26 +292,11 @@ we can declare an array of that type: type(fun_del), dimension(10, 20) :: tar ``` -and a reference like - -```f90 -tar(n, 2) -``` - -is an element (a scalar!) of type `fun_del`, but - -```f90 -tar(n, 2)%du -``` - -is an array of type `real`, and - -```f90 -tar(n, 2)%du(2) -``` - -is an element of it. The basic rule to remember is that an array element -always has a subscript or subscripts qualifying at least the last name. +A reference like `tar(n, 2)` is an element (a scalar!) of type +`fun_del`, but `tar(n, 2)%du` is an array of type `real`, and +`tar(n, 2)%du(2)` is an element of it. The basic rule to remember +is that an array element always has a subscript or subscripts +qualifying at least the last name. ## Array subobjects (sections) diff --git a/source/learn/f95_features/data_transfer.md b/source/learn/f95_features/data_transfer.md index 2bc24f368373..f8aab58b62d6 100644 --- a/source/learn/f95_features/data_transfer.md +++ b/source/learn/f95_features/data_transfer.md @@ -3,7 +3,9 @@ ## Formatted input/output These examples illustrate various forms of I/O lists with some simple -formats (see [below](edit_descriptors)): +formats (see +[Edit descriptors](edit_descriptors) +below): ```f90 integer :: i @@ -59,7 +61,8 @@ print form, q ``` or as an asterisk this is a type of I/O known as *list-directed* I/O -(see [below](list-directed-i/o), +(see +[below](list-directed-i-o)), in which the format is defined by the computer system: ```f90 @@ -223,10 +226,10 @@ It is possible to specify that an edit descriptor be repeated a specified number of times, using a *repeat count*: `10f12.3` The slash edit descriptor (see -[below](control-edit-descriptors)) -may have a repeat count, and a repeat count can -also apply to a group of edit descriptors, enclosed in parentheses, with -nesting: +[Control edit descriptors](control-edit-descriptors) +below) may have a great count, and +a repeat count can also apply to a group of edit descriptors, +enclosed in parentheses, with nesting: ```f90 print "(2(2i5,2f8.2))", i(1),i(2),a(1),a(2), i(3),i(4),a(3),a(4) diff --git a/source/learn/f95_features/expressions_and_assignments.md b/source/learn/f95_features/expressions_and_assignments.md index 487c1f1fb166..fee395e508c9 100644 --- a/source/learn/f95_features/expressions_and_assignments.md +++ b/source/learn/f95_features/expressions_and_assignments.md @@ -44,8 +44,10 @@ of real numbers to integers: For *scalar relational* operations of numeric types, there is a set of built-in operators: -`< <= == /= > >=` -`.lt. .le. .eq. .ne. .gt. .ge.` +```f90 + < <= == /= > >= +.lt. .le. .eq. .ne. .gt. .ge. +``` (the forms above are new to Fortran-90, and older equivalent forms are given below them). Example expressions: @@ -113,7 +115,7 @@ vector3 =(matrix .times. vector1) + vector2 the two expressions are equivalent only if appropriate parentheses are added as shown. In each case there must be defined, in a -[module](modules), +[module](program_units_and_procedures.md#modules), procedures defining the operator and assignment, and corresponding operator-procedure association, as follows: @@ -126,7 +128,7 @@ end interface The string concatenation function is a more elaborated version of that shown already in -[Basics](Basics). +[Basics](language_elements.md#basics). Note that in order to handle the error condition that arises when the two strings together exceed the preset 80-character limit, it would be safer to use diff --git a/source/learn/f95_features/language_elements.md b/source/learn/f95_features/language_elements.md index 00c89bcb1ae0..8db2cef1b4e3 100644 --- a/source/learn/f95_features/language_elements.md +++ b/source/learn/f95_features/language_elements.md @@ -125,7 +125,7 @@ range(1_two_bytes) ``` Also, in -[`data` (initialization) statements](data_statement), +[`data` (initialization) statements](data-statement), binary (`B`), octal (`O`) and hexadecimal (`Z`) constants may be used (often informally referred to as "BOZ constants"): @@ -478,7 +478,7 @@ attribute and the constant values to a type statement: real, dimension(3), parameter :: field = (/0., 1., 2./) type(triplet), parameter :: t = triplet((/0., 0., 0./)) ``` -(data_statement)= + ### `data` statement The `data` statement can be used for scalars and also for arrays and diff --git a/source/learn/f95_features/pointers.md b/source/learn/f95_features/pointers.md index d487d8a2dccd..c011177dd099 100644 --- a/source/learn/f95_features/pointers.md +++ b/source/learn/f95_features/pointers.md @@ -13,7 +13,8 @@ They are conceptually a descriptor listing the attributes of the objects (targets) that the pointer may point to, and the address, if any, of a target. They have no associated storage until it is allocated or otherwise associated (by pointer assignment, see -[Pointers in expressions and assignments](pointers_in_expressions_and_assignments)): +[Pointers in expressions and assignments](pointers-in-expressions-and-assignments) +below): ```f90 allocate (var) @@ -289,7 +290,8 @@ window => table(m:n, p:q) The subscripts of window are `1:n - m + 1, 1:q - p + 1`. Similarly, for `tar%u` (as defined in -[Array elements](array_elements)), +[Array elements](array_handling.md#array-elements) +of section Array handling), we can use, say, `taru => tar%u` to point at all the u components of tar, and subscript it as `taru(1, 2)`. diff --git a/source/learn/f95_features/program_units_and_procedures.md b/source/learn/f95_features/program_units_and_procedures.md index aaa19179f789..7ef4a5fd3752 100644 --- a/source/learn/f95_features/program_units_and_procedures.md +++ b/source/learn/f95_features/program_units_and_procedures.md @@ -76,7 +76,6 @@ The names of program units and external procedures are *global*, and the names of implied-DO variables have a scope of the statement that contains them. -(modules)= ## Modules Modules are used to package @@ -201,7 +200,7 @@ Also, `inout` is possible: here the actual argument must be a variable Arguments may be optional: ```f90 -subroutine mincon(n, f, x, upper, lower, equalities, inequalities, & +subroutine mincon(n, f, x, upper, lower, equalities, inequalities, & convex, xstart) real, optional, dimension :: upper, lower : @@ -255,10 +254,10 @@ An explicit interface is obligatory for - optional and keyword arguments; - `pointer` and `target` arguments (see - [Pointers](pointers)); + [Pointers](pointers.md)); - `pointer` function result; - new-style array arguments and array functions - ([Array handling](array_handling)). + ([Array handling](array_handling.md)). It allows full checks at compile time between actual and dummy arguments. @@ -293,12 +292,12 @@ interface gamma end interface ``` -We can use existing names, e.g. SIN, and the compiler sorts out the +We can use existing names, e.g. `sin`, and the compiler sorts out the correct association. We have already seen the use of interface blocks for defined operators and assignment (see -[Modules](Modules)). +[Modules](modules)). ## Recursion @@ -355,7 +354,7 @@ Here, we note the `result` clause and termination test. This is a feature for parallel computing. In -[the `forall` statement and construct](forall-statement), +[the `forall` statement and construct](array_handling.md#the-forall-statement-and-construct), any side effects in a function can impede optimization on a parallel processor the order of execution of the assignments could affect the results. To control this situation, we add the `pure` keyword From e89d6943ebc5fd30491e9a44b516549ab32516d6 Mon Sep 17 00:00:00 2001 From: nbehrnd Date: Mon, 30 Jun 2025 14:40:34 +0200 Subject: [PATCH 10/10] correction of typos --- source/learn/f95_features/array_handling.md | 2 +- source/learn/f95_features/data_transfer.md | 2 +- source/learn/f95_features/fprettify.rc | 2 +- source/learn/f95_features/index.md | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/source/learn/f95_features/array_handling.md b/source/learn/f95_features/array_handling.md index a364e37fd266..b2ba606f965e 100644 --- a/source/learn/f95_features/array_handling.md +++ b/source/learn/f95_features/array_handling.md @@ -223,7 +223,7 @@ Further: ## The `forall` statement and construct When a `do` construct is executed, each successive iteration is -performed in order and one after the otheran impediment to optimization +performed in order and one after the other is an impediment to optimization on a parallel processor. ```f90 diff --git a/source/learn/f95_features/data_transfer.md b/source/learn/f95_features/data_transfer.md index f8aab58b62d6..7d6909afed82 100644 --- a/source/learn/f95_features/data_transfer.md +++ b/source/learn/f95_features/data_transfer.md @@ -85,7 +85,7 @@ where `unit=` is optional. The value may be any nonnegative integer allowed by the system for this purpose (but `0`, `5` and `6` often denote the error, keyboard and terminal, respectively). -An asterisk is a variantagain from the keyboard: +An asterisk is a variant again from the keyboard: ```f90 read (unit=*, fmt="(f10.3)") q diff --git a/source/learn/f95_features/fprettify.rc b/source/learn/f95_features/fprettify.rc index 82b2e3549c71..4f3127156cf1 100644 --- a/source/learn/f95_features/fprettify.rc +++ b/source/learn/f95_features/fprettify.rc @@ -1,7 +1,7 @@ # style configuration file for fprettify # original source: https://github.com/PHOTOX/ABIN/blob/master/.fprettify.rc # original author: Daniel Hollas -# original licence: GPL v3 +# original license: GPL v3 # # minor edits to the original to fit better the pattern other booklets use diff --git a/source/learn/f95_features/index.md b/source/learn/f95_features/index.md index 7e8e1e099c8f..b401916a75d4 100644 --- a/source/learn/f95_features/index.md +++ b/source/learn/f95_features/index.md @@ -16,7 +16,7 @@ Bibliography ::: This is an overview of **Fortran 95 language features** which is based -upon the standards document[^iso_1539_1997] which has been replaced byi +upon the standards document[^iso_1539_1997] which has been replaced by a newer version.[^iso_1539_2023] Included are the additional features of TR-15581:Enhanced Data Type Facilities, which have been universally implemented. Old features that have been superseded by new ones are not