diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index d3e4e99ca..b55fca961 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -92,8 +92,8 @@ This will force the GitHub content delivery network to serve you an updated vers ### Markdown -- Use [code blocks](https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet#code-and-syntax-highlighting), - denoted by back ticks (```), to surround code excerpts, programming language keywords, variables names and file names. +- Place code excerpts in [code blocks](https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet#code-and-syntax-highlighting), + denoted by back ticks (```` ``` ````). Use inline code style (`` `code` ``) for inline code excerpts, programming language keywords, variables names and file names. - Have no more than one sentence per source-code line, and break-up long sentences across multiples lines - this is important to avoid large git diffs and code review blocks on github. @@ -185,3 +185,124 @@ populated by the `

` headings on the current page. __Implementation:__ the functionality described above is implemented in the javascript file [assets/js/page_nav.js](./assets/js/page_nav.js). + + +## Tutorials + +Guidelines for mini-book content. + +### General + +Use the `book` layout. + +Follow the [Markdown guidelines](#markdown). + +### Code style + +Use two spaces for indentation, indenting bodies of units but keeping the `contains` statement at the same level as its `module` or `type`. Try to limit line length to 90 characters. These considerations should make the code more readable and easier to view on devices with smaller viewport widths. +```fortran +module m + implicit none + private + public :: a_t + + type :: a_t + integer :: val + contains + procedure :: func + end type a_t + +contains + + subroutine func(self) + class(a_t), intent(in) :: self + if (self%val > 0) then + print *, self%val + end if + end function func + +end module m +``` + +Each code block should have a base indentation level of 0, even if it would be indented if put into a larger context. +```fortran +integer :: i1 ! yes + integer :: i2 ! no +``` + +Avoid vertically aligning `::` and inline comments since this adds maintenance burden and pushes the line length in most cases. + +If a code block contains lines that are not valid Fortran, leave it as a language-less code block to avoid the syntax highlighter's red boxes. +``` +module +... +end module +``` + +Feel free to omit spacing in expressions where it helps with readability, but generally include whitespace around operators. +```fortran +y1 = a * b +y2 = a*b + c*d ! instead of a * b + c * d +y3 = a**2 + 1 +y4 = (a*b + c*d) / 2 +s3 = s1 // s2 +``` + +Generally add a space after commas, except when indexing with short index values or variables names. +```fortran +a(:,1) +a2(1:10, 2:5) +b(i,j) +b2(long_i_name, long_j_name) +b3(i + 2, j) +call some_subroutine(a, b, an_option=.false.) +c = [1, 2, 3, 10] +d = [(i, i = 1, 10)] +do i = 1, 10 +! ... +``` + +Other situations besides simple indexings where white space can be omitted: +* Aliasing in imports + ```fortran + use, intrinsic :: iso_c_binding, only: sp=>c_float, dp=>c_double + ``` +* String concatentation + ```fortran + print *, 'hello '//'world' + ``` +* Accessing components (attributes) of derived types + ```fortran + p%x + p%calc_something(a, b) + ``` +* Around `=` when passing keyword arguments + ```fortran + call sr(a, b, c=3) + point = t_point(x=1., y=2.) + character(len=:), allocatable :: s + ``` + +Capitalize the first letter for inline comments except for trailing inline comments that only consist of one word or a short phrase. +```fortran +! Compute new values +y = m*x + b ! meters +``` + +These code style recommendations are similar to those in [the DFTB+ style guide](https://dftbplus-develguide.readthedocs.io/en/latest/fortranstyle.html). + +### Text + +Use sentence case (as opposed to title case) for page and section titles. + +Use *emphasis* (`*emphasis*`/`_emphasis_`, rendered as italic) for key words/phrases when they are first introduced, for emphasis, ... + +Avoid use of **strong** (`**strong**`, rendered as bold) within paragraphs, since bold style is used for headings, drawing attention to examples (**Example:**), admonition/aside titles, etc. + +Make use of the admonition/aside [includes](_includes) (*note*, *tip*, *important*) where appropriate. +* *note*: extra information, something that might appear in a footnote +* *tip*: information about best practices, practical tips +* *important*: warnings, things to avoid, etc. + +Prefer including the [Oxford comma](https://en.wikipedia.org/wiki/Serial_comma). It usually makes things more clear. +> Fortran is fast, fun, and famed. diff --git a/assets/css/main.css b/assets/css/main.css index 27e5fdd98..af82f8efb 100644 --- a/assets/css/main.css +++ b/assets/css/main.css @@ -137,7 +137,8 @@ blockquote small:before { } pre { - overflow: auto; + overflow-x: scroll; + overflow-y: auto; padding: 0.8rem; border-radius: 0.2rem; border: solid 1px rgba(0, 0, 0, 0.1); @@ -145,6 +146,10 @@ pre { white-space: pre-wrap; } +pre code { + white-space: pre; /* `pre-wrap` in Bootstrap */ +} + .container { margin: 0 15px; } @@ -301,7 +306,7 @@ pre { @media (min-width: 568px) { .col-right { /* display: table-cell; */ - width: 61.8%; + width: calc(100% - 380px); vertical-align: top; margin-left: 380px; min-height: 500px; diff --git a/learn/quickstart/arrays_strings.md b/learn/quickstart/arrays_strings.md index 9995ec52b..24dda5d37 100644 --- a/learn/quickstart/arrays_strings.md +++ b/learn/quickstart/arrays_strings.md @@ -9,16 +9,16 @@ permalink: /learn/quickstart/arrays_strings More often than not, we need to store and operate on long lists of numbers as opposed to just the single scalar variables that we have been using so far; in computer programming such lists are called _arrays_. -Arrays are _multidimensional_ variables which contain more than value -where each value is accessed using one or indices. +Arrays are _multidimensional_ variables that contain more than one value +where each value is accessed using one or more indices. -{% include important.html content="Arrays in Fortran are __one-based__ by default; this means +{% include important.html content="Arrays in Fortran are _one-based_ by default; this means that the first element along any dimension is at index 1." %} ## Array declaration -We can declare arrays of any type. There are two common notations for declaring array variables; +We can declare arrays of any type. There are two common notations for declaring array variables: using the `dimension` attribute or by appending the array dimensions in parentheses to the variable name. __Example:__ static array declaration @@ -33,7 +33,7 @@ program arrays integer :: array2(10) ! 2D real array - real, dimension(10,10) :: array3 + real, dimension(10, 10) :: array3 ! Custom lower and upper index bounds real :: array4(0:9) @@ -53,32 +53,32 @@ program array_slice implicit none integer :: i - integer :: array1(10) ! 1D integer array of 10 elements - integer :: array2(10,10) ! 2D integer array of 100 elements + integer :: array1(10) ! 1D integer array of 10 elements + integer :: array2(10, 10) ! 2D integer array of 100 elements - array1 = [1,2,3,4,5,6,7,8,9,10] ! Array constructor - array1 = [(i,i=1,10)] ! Implied do loop constructor - array1(:) = 0 ! set all elements to zero - array1(1:5) = 1 ! set first five elements to one - array1(6:) = 1 ! set all elements after five to one + array1 = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] ! Array constructor + array1 = [(i, i = 1, 10)] ! Implied do loop constructor + array1(:) = 0 ! Set all elements to zero + array1(1:5) = 1 ! Set first five elements to one + array1(6:) = 1 ! Set all elements after five to one - print *,array1(1:10:2) ! print out elements at odd indices - print *,array2(:,1) ! print out the first column in a 2D array - print *,array1(10:1:-1) ! print an array in reverse + print *, array1(1:10:2) ! Print out elements at odd indices + print *, array2(:,1) ! Print out the first column in a 2D array + print *, array1(10:1:-1) ! Print an array in reverse end program array_slice ``` -{% include note.html content="Fortran arrays are stored in __column major__ order; the first +{% include note.html content="Fortran arrays are stored in _column-major_ order; the first index varies fastest." %} ## Allocatable (dynamic) arrays -So far we have specified the size of our array in our program code - -this type of array is known as a _static_ array since its size is fixed when +So far we have specified the size of our array in our program code---this +type of array is known as a _static_ array since its size is fixed when we compile our program. -Quite often, we do not know how big our array needs to be until we run our program, for example if we are reading data from a file of unknown size. +Quite often, we do not know how big our array needs to be until we run our program, for example, if we are reading data from a file of unknown size. For this problem, we need `allocatable` arrays. These are _allocated_ while the program is runnning once we know how big the array needs to be. @@ -94,7 +94,7 @@ program allocatable allocate(array1(10)) allocate(array2(10,10)) - ... + ! ... deallocate(array1) deallocate(array2) diff --git a/learn/quickstart/derived_types.md b/learn/quickstart/derived_types.md index b63f232f3..e28da8805 100644 --- a/learn/quickstart/derived_types.md +++ b/learn/quickstart/derived_types.md @@ -4,7 +4,7 @@ title: Derived types permalink: /learn/quickstart/derived_types --- -As discussed previously in [Variables]({{site.baseurl}}/learn/quickstart/variables) there are five built-in data types in Fortran. _Derived types_ is a special form of a data type that can encapsulate other built-in types as well as other derived types. It could be considered as the equivalent of _struct_ in the C and C++ programming languages. +As discussed previously in [Variables]({{site.baseurl}}/learn/quickstart/variables), there are five built-in data types in Fortran. A _derived type_ is a special form of data type that can encapsulate other built-in types as well as other derived types. It could be considered equivalent to _struct_ in the C and C++ programming languages. ## A quick take on derived types @@ -12,18 +12,18 @@ Here's an example of a basic derived type: ```fortran type :: t_pair - integer :: i - real :: x + integer :: i + real :: x end type ``` -The syntax to create a variable of type _t_pair_ and access its members is: +The syntax to create a variable of type `t_pair` and access its members is: ```fortran -! declare +! Declare type(t_pair) :: pair -! initialize -pair%i = 1 -pair%x = 0.5 +! Initialize +pair%i = 1 +pair%x = 0.5 ``` {% include note.html content="The percentage symbol `%` is used to access the members of a derived type." %} @@ -34,35 +34,35 @@ You can also initialize derived type members by invoking the derived type constr Example using the derived type constructor: ```fortran -pair = t_pair(1, 0.5) ! initialize with positional arguments -pair = t_pair(i=1, x=0.5) ! initialize with keyword arguments -pair = t_pair(x=0.5, i=1) ! keyword arguments can go in any order +pair = t_pair(1, 0.5) ! Initialize with positional arguments +pair = t_pair(i=1, x=0.5) ! Initialize with keyword arguments +pair = t_pair(x=0.5, i=1) ! Keyword arguments can go in any order ``` Example with default initialization: ```fortran type :: t_pair - integer :: i = 1 - real :: x = 0.5 + integer :: i = 1 + real :: x = 0.5 end type type(t_pair) :: pair -pair = t_pair() ! pair%i is 1, pair%x is 0.5 -pair = t_pair(i=2) ! pair%i is 2, pair%x is 0.5 -pair = t_pair(x=2.7) ! pair%i is 1, pair%x is 2.7 +pair = t_pair() ! pair%i is 1, pair%x is 0.5 +pair = t_pair(i=2) ! pair%i is 2, pair%x is 0.5 +pair = t_pair(x=2.7) ! pair%i is 1, pair%x is 2.7 ``` ## Derived types in detail The full syntax of a derived type with all optional properties is presented below: -```fortran +``` type [,attribute-list] :: name [(parameterized-declaration-list)] - [parameterized-definition-statements] - [private statement or sequence statement] - [member-variables] - contains - [type-bound-procedures] + [parameterized-definition-statements] + [private statement or sequence statement] + [member-variables] +contains + [type-bound-procedures] end type ``` @@ -72,124 +72,143 @@ end type - _access-type_ that is either `public` or `private` - `bind(c)` offers interoperability with C programming language -- `extends(`_parent_`)` where _parent_ is the name of a previously declared derived type, from which, the current derived type will inherit all its members and functionality. -- `abstract` an object oriented feature that is covered in the advanced programming tutorial. +- `extends(`_parent_`)`, where _parent_ is the name of a previously declared derived type from which the current derived type will inherit all its members and functionality +- `abstract` -- an object oriented feature that is covered in the advanced programming tutorial -{% include note.html content="If the `attribute: bind(c)` or the `statement: sequence` is used then a derived type cannot have the `attribute: extends` and visa-versa." %} +{% include note.html content="If the attribute `bind(c)` or the statement `sequence` is used, then a derived type cannot have the attribute `extends` and vice versa." %} The `sequence` attribute may be used only to declare that the following members should be accessed in the same order as they are defined within the derived type. Example with `sequence`: ```fortran type :: t_pair -sequence -integer :: i -real :: x + sequence + integer :: i + real :: x end type -! init +! Initialize type(t_pair) :: pair pair = t_pair(1, 0.5) ``` -{% include note.html content="The use of statement `sequence` presupposes that the data types defined below are neither of `allocatable` nor of `pointer` type. Furthermore, it does not imply that these data types will be stored in memory in any particular form, there is no relation to `contiguous` attribute." %} +{% include note.html content="The use of the statement `sequence` presupposes that the data types defined below are neither of `allocatable` nor of `pointer` type. Furthermore, it does not imply that these data types will be stored in memory in any particular form, i.e., there is no relation to the `contiguous` attribute." %} -The _access-type_ attributes `public` and `private` if used, declare that all [member-variables] declared below will be automatically assigned the attribute accordingly. +The _access-type_ attributes `public` and `private`, if used, declare that all member-variables declared below will be automatically assigned the attribute accordingly. The attribute `bind(c)` is used to achieve compatibility between Fortran's derived type and C's struct. Example with `bind(c)`: ```fortran module f_to_c -use iso_c_bindings, only: c_int -implicit none -type, bind(c) :: f_type + use iso_c_bindings, only: c_int + implicit none + + type, bind(c) :: f_type integer(c_int) :: i -end type + end type + end module f_to_c ``` -matches the following C struct: +matches the following C struct type: ```c -struct{ - int i -}c_struct; +struct c_struct { + int i; +}; ``` {% include note.html content="A fortran derived type with the attribute `bind(c)` cannot have the `sequence` and `extends` attributes. Furthermore it cannot contain any Fortran `pointer` or `allocatable` types." %} -`parameterized-declaration-list`: is an optional feature. If used, then the parameters must be listed in place of [parameterized-definition-statements] and must be either `len` or `kind` parameters or both. +`parameterized-declaration-list` is an optional feature. If used, then the parameters must be listed in place of `[parameterized-definition-statements]` and must be either `len` or `kind` parameters or both. -Example of a derived type with `parameterized-declaration-list` and with the `attribute: public`: +Example of a derived type with `parameterized-declaration-list` and with the attribute `public`: ```fortran module m_matrix -implicit none -private - -type, public :: t_matrix(rows, cols, k) - integer, len :: rows, cols - integer, kind :: k = kind(0.0) - real(kind = k), dimension(rows, cols) :: values -end type + implicit none + private + + type, public :: t_matrix(rows, cols, k) + integer, len :: rows, cols + integer, kind :: k = kind(0.0) + real(kind=k), dimension(rows, cols) :: values + end type + end module m_matrix program test_matrix -use m_matrix -implicit none -type(t_matrix(rows=5, cols=5)) :: m + use m_matrix + implicit none + + type(t_matrix(rows=5, cols=5)) :: m + end program test_matrix ``` -{% include note.html content="In this example the parameter **k** has already been assigned a default value of `kind(0.0)`, that is of floating point single precision. Therefore, it can be omitted, as it is the case here in the declaration inside the main program." %} +{% include note.html content="In this example the parameter `k` has already been assigned a default value of `kind(0.0)` (single-precision floating-point). Therefore, it can be omitted, as is the case here in the declaration inside the main program." %} -{% include important.html content="By default derived types and their members are public. However, in this example the attribute `private` is used at the beginning of the module, therefore, everything within the module will be by default `private` unless, explicitly, declared as `public`. If the type **matrix** was not given the attribute `public` in the above example, then the compiler would throw an error inside **program test**." %} +{% include important.html content="By default, derived types and their members are public. However, in this example, the attribute `private` is used at the beginning of the module. Therefore, everything within the module will be by default `private` unless explicitly declared as `public`. If the type `t_matrix` was not given the attribute `public` in the above example, then the compiler would throw an error inside `program test`." %} -The attribute `extends` was added in F2003 standard and introduces an important feature of the object oriented paradigm (OOP), namely the inheritance. It allows code reusability by letting children-derived-types like this: `type, extends(parent) :: child` to inherit all the members and functionality from a parent-derived-type: `type :: parent`. +The attribute `extends` was added in the F2003 standard and introduces an important feature of the object oriented paradigm (OOP), namely inheritance. It allows code reusability by letting child types derive from extensible parent types: `type, extends(parent) :: child`. Here, `child` inherits all the members and functionality from `type :: parent`. -Example with the attribute `extends`: +Example with the attribute `extends`: ```fortran module m_employee -implicit none -private -public t_date, t_address, t_person, t_employee ! note another way of using the public attribute by gathering all public data types in one place + implicit none + private + public t_date, t_address, t_person, t_employee + ! Note another way of using the public attribute: + ! gathering all public data types in one place. + + type :: t_date + integer :: year, month, day + end type + + type :: t_address + character(len=:), allocatable :: city, road_name + integer :: house_number + end type + + type, extends(t_address) :: t_person + character(len=:), allocatable :: first_name, last_name, e_mail + end type + + type, extends(t_person) :: t_employee + type(t_date) :: hired_date + character(len=:), allocatable :: position + real :: monthly_salary + end type -type :: t_date - integer :: year, month, day -end type - -type :: t_address - character(len=:), allocatable :: city, road_name - integer :: house_number -end type - -type, extends(t_address) :: t_person - character(len=:), allocatable :: first_name, last_name, e_mail -end type - -type, extends(t_person) :: t_employee - type(t_date) :: hired_date - character(len=:), allocatable :: position - real :: monthly_salary -end type end module m_employee program test_employee -use m_employee -implicit none -type(t_employee) :: employee - -! initialization -employee%hired_date%year = 2020 ! t_employee has access to type(t_date) members not because of extends but because a type(t_date) was declared within t_employee -employee%hired_date%month = 1 -employee%hired_date%day = 20 -employee%first_name = 'John' !t_employee has access to t_person, and inherits its members due to extends -employee%last_name = 'Doe' -employee%city = 'London' ! t_employee has access to t_address, because it inherits from t_person, that in return inherits from t_address -employee%road_name = 'BigBen' -employee%house_number = 1 -employee%position = 'Intern' -employee%monthly_salary = 0.0 + use m_employee + implicit none + type(t_employee) :: employee + + ! Initialization + + ! t_employee has access to type(t_date) members not because of extends + ! but because a type(t_date) was declared within t_employee. + employee%hired_date%year = 2020 + employee%hired_date%month = 1 + employee%hired_date%day = 20 + + ! t_employee has access to t_person, and inherits its members due to extends. + employee%first_name = 'John' + employee%last_name = 'Doe' + + ! t_employee has access to t_address, because it inherits from t_person, + ! which in return inherits from t_address. + employee%city = 'London' + employee%road_name = 'BigBen' + employee%house_number = 1 + + ! t_employee has access to its defined members. + employee%position = 'Intern' + employee%monthly_salary = 0.0 + end program test_employee ``` ## Options to declare members of a derived type -`[member-variables]` refers to the declaration of all the member data types. These data types can be of any built-in data type, and/or of other derived types, as already show-cased in the above examples. However, member-variables can have their own extensive syntax, in form of: +`[member-variables]` refers to the declaration of all the member data types. These data types can be of any built-in data type, and/or of other derived types, as already showcased in the above examples. However, member-variables can have their own extensive syntax, in form of: `type [,member-attributes] :: name[attr-dependent-spec][init]` `type`: any built-in type or other derived type @@ -205,16 +224,21 @@ Examples of common cases: ```fortran type :: t_example - !1st case: simple built-in type with access attribute and [init] - integer, private :: i = 0 ! private hides it from use outside of the t_example's scope. The default initialization [=0] is the [init] part. - - !2nd case: protected - integer, protected :: i ! In contrary to private, protected allows access to i assigned value outside of t_example but is not definable, i.e. a value may be assigned to i only within t_example. - - !3rd case: dynamic 1d_array - real, allocatable, dimension(:) :: x - ! the same as - real, allocatable :: x(:) ! parenthesis implies dimension(:) and is one of the possible [attr-dependent-spec]. + ! 1st case: simple built-in type with access attribute and [init] + integer, private :: i = 0 + ! private hides it from use outside of the t_example's scope. + ! The default initialization [=0] is the [init] part. + + ! 2nd case: protected + integer, protected :: i + ! In contrary to private, protected allows access to i assigned value outside of t_example + ! but is not definable, i.e. a value may be assigned to i only within t_example. + + ! 3rd case: dynamic 1-D array + real, allocatable, dimension(:) :: x + ! the same as + real, allocatable :: x(:) + ! This parentheses' usage implies dimension(:) and is one of the possible [attr-dependent-spec]. end type ``` @@ -222,7 +246,7 @@ end type ## Type-bound procedures -A derived type can contain functions or subroutines that are **bound** to it. We'll refer to them as _type-bound procedures_. Type-bound procedures follow the `contains` statement that, in turn, follows all member variable declarations. +A derived type can contain functions or subroutines that are *bound* to it. We'll refer to them as _type-bound procedures_. Type-bound procedures follow the `contains` statement that, in turn, follows all member variable declarations. {% include note.html content="It is impossible to describe type-bound procedures in full without delving into OOP features of modern Fortran. For now we'll focus on a simple example to show their basic use." %} @@ -230,60 +254,69 @@ Here's an example of a derived type with a basic type-bound procedure: ```fortran module m_shapes -implicit none -private -public t_square - -type :: t_square - real :: side - contains - procedure :: area !procedure declaration -end type + implicit none + private + public t_square + + type :: t_square + real :: side + contains + procedure :: area ! procedure declaration + end type contains - ! procedure definition - real function area(self) result(res) - class(t_square), intent(in) :: self - res = self%side**2 - end function + + ! Procedure definition + real function area(self) result(res) + class(t_square), intent(in) :: self + res = self%side**2 + end function + end module m_shapes program main -use m_shapes -implicit none -! variables declaration -type(t_square) :: sq -real :: x, side - -! variables initialization -side = 0.5 -sq%side = side - -x = sq%area() ! self does not appear here, it has been passed implicitly -! do stuff with x... + use m_shapes + implicit none + + ! Variables' declaration + type(t_square) :: sq + real :: x, side + + ! Variables' initialization + side = 0.5 + sq%side = side + + x = sq%area() + ! self does not appear here, it has been passed implicitly + + ! Do stuff with x... + end program main ``` What is new: - - **self** is an arbitrary name that we chose to represent the instance of the derived type t_square inside the type-bound function. This allows us to access its members and to automatically pass it as an argument when we invoke a type-bound procedure. - - We now use `class(t_square)` instead of `type(t_square)` in the interface of the `area` function. This allows us to invoke the `area` function with any derived type that extends `t_square`. The keyword `class` introduces the OOP feature, polymorphism. + - `self` is an arbitrary name that we chose to represent the instance of the derived type `t_square` inside the type-bound function. This allows us to access its members and to automatically pass it as an argument when we invoke a type-bound procedure. + - We now use `class(t_square)` instead of `type(t_square)` in the interface of the `area` function. This allows us to invoke the `area` function with any derived type that extends `t_square`. The keyword `class` introduces the OOP feature polymorphism. -In the above example, the type-bound procedure **area** is defined as a function and can be invoked only in an expression, for example `x = sq%area()` or `print *, sq%area()`. If you define it instead as a subroutine, you can invoke it from its own `call` statement: +In the above example, the type-bound procedure `area` is defined as a function and can be invoked only in an expression, for example `x = sq%area()` or `print *, sq%area()`. If you define it instead as a subroutine, you can invoke it from its own `call` statement: - ```fortran - ! change within module - contains - subroutine area(self, x) - class(t_square), intent(in) :: self - real, intent(out) :: x - x = self%side**2 - end subroutine - -! change within main program +```fortran +! Change within module +contains + subroutine area(self, x) + class(t_square), intent(in) :: self + real, intent(out) :: x + x = self%side**2 + end subroutine + +! ... + +! Change within main program call sq%area(x) -! do stuff with x... - ``` + +! Do stuff with x... +``` In contrast to the example with the type-bound function, we now have two arguments: -* `class(t_square), intent(in) :: self`, which is the instance of the derived type itself -* `real, intent(out) :: x`, which is used to store the calculated area and return to the caller. +* `class(t_square), intent(in) :: self` -- the instance of the derived type itself +* `real, intent(out) :: x` -- used to store the calculated area and return to the caller diff --git a/learn/quickstart/hello_world.md b/learn/quickstart/hello_world.md index cd34c0f62..e47840461 100644 --- a/learn/quickstart/hello_world.md +++ b/learn/quickstart/hello_world.md @@ -1,16 +1,16 @@ --- layout: book -title: Hello World +title: Hello world permalink: /learn/quickstart/hello_world --- In this part of the tutorial, we will write our first Fortran program: -the ubiquitous _Hello World_ example. +the ubiquitous ["Hello, World!"](https://en.wikipedia.org/wiki/%22Hello,_World!%22_program) example. -However before we can write our program, we need to ensure that we have +However, before we can write our program, we need to ensure that we have a Fortran compiler set up. -{% include note.html content="Fortran is a compiled language which means that once written, the source code must be passed through a +{% include note.html content="Fortran is a *compiled language*, which means that, once written, the source code must be passed through a compiler to produce a machine executable that can be run." %} ## Compiler setup @@ -18,13 +18,13 @@ compiler to produce a machine executable that can be run." %} In this tutorial, we'll work with the free and open source [GNU Fortran compiler (gfortran)](https://gcc.gnu.org/fortran/), which is part of the -[GNU Compiler Colection (GCC)](https://gcc.gnu.org/). +[GNU Compiler Collection (GCC)](https://gcc.gnu.org/). To install gfortran on Linux, use your system package manager. On macOS, you can install gfortran using [Homebrew](https://brew.sh/) or [MacPorts](https://www.macports.org/). On Windows, you can get native binaries [here](http://www.equation.com/servlet/equation.cmd?fa=fortran). -To check if you have _gfortran_ setup correctly, open a terminal and run the following command : +To check if you have _gfortran_ setup correctly, open a terminal and run the following command: ```shell $> gfortran --version @@ -41,11 +41,11 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ## Hello world -Once you have setup up your compiler, open a new file in your favourite code editor and enter the following: +Once you have set up your compiler, open a new file in your favourite code editor and enter the following: ```fortran program hello - ! This is a comment line, it is ignored by the compiler + ! This is a comment line; it is ignored by the compiler print *, 'Hello, World!' end program hello ``` @@ -55,8 +55,8 @@ Having saved your program to `hello.f90`, compile at the command line with: $> gfortran hello.f90 -o hello ``` -{% include note.html content=".f90 is the standard file extension for modern fortran source files. -The 90 refers to the first modern fortran standard in 1990." %} +{% include note.html content="`.f90` is the standard file extension for modern Fortran source files. +The 90 refers to the first modern Fortran standard in 1990." %} To run your compiled program: ```shell @@ -64,5 +64,5 @@ $> ./hello Hello, World! ``` -Congratulations you've written, compiled and run your first Fortran program! -In the next part of this tutorial we will introduce variables for storing data. +Congratulations, you've written, compiled and run your first Fortran program! +In the next part of this tutorial, we will introduce variables for storing data. diff --git a/learn/quickstart/operators_control_flow.md b/learn/quickstart/operators_control_flow.md index 0115ef99a..5bd547b85 100644 --- a/learn/quickstart/operators_control_flow.md +++ b/learn/quickstart/operators_control_flow.md @@ -1,11 +1,11 @@ --- layout: book -title: Operators and Control Flow +title: Operators and flow control permalink: /learn/quickstart/operators_control_flow --- One of the powerful advantages of computer algorithms, compared to simple mathematical formulae, -comes in the form program _branching_ whereby the program can decide which instructions to +comes in the form of program _branching_ whereby the program can decide which instructions to execute next based on a logical condition. There are two main forms of controlling program flow: @@ -20,7 +20,7 @@ There are two main forms of controlling program flow: Before we use a conditional branching operator, we need to be able to form a logical expression. -To form a logical expression the following set of relational operators are available: +To form a logical expression, the following set of relational operators are available: | Operator   | Alternative   | Description | |:----------------:|:---------------------:|-----------------------------------------------------------------| @@ -54,43 +54,43 @@ message to describe the nature of the `angle` variable: __Example:__ single branch `if` ```fortran - if (angle < 90.0) then - print *, 'Angle is acute' - end if +if (angle < 90.0) then + print *, 'Angle is acute' +end if ``` -In this first example, the code within the `if` construct is __only executed if__ the +In this first example, the code within the `if` construct is _only executed if_ the test expression (`angle < 90.0`) is true. {% include tip.html content="It is good practice to indent code within constructs such as `if` and `do` to make code more readable." %} -We can add alternative branch to the construct using the `else` keyword: +We can add an alternative branch to the construct using the `else` keyword: -__Example:__ two-branch `if-else` +__Example:__ two-branch `if`-`else` ```fortran - if (angle < 90.0) then - print *, 'Angle is acute' - else - print *, 'Angle is obtuse' - end if +if (angle < 90.0) then + print *, 'Angle is acute' +else + print *, 'Angle is obtuse' +end if ``` -Now there are two _branches_ in the `if` construct, but __only one branch is executed__ depending +Now there are two _branches_ in the `if` construct, but _only one branch is executed_ depending on the logical expression following the `if` keyword. We can actually add any number of branches using `else if` to specify more conditions: -__Example:__ multi-branch `if-elseif-else` +__Example:__ multi-branch `if`-`else if`-`else` ```fortran - if (angle < 90.0) then - print *, 'Angle is acute' - else if (angle < 180.0) then - print *, 'Angle is obtuse' - else - print *, 'Angle is reflex' - end if +if (angle < 90.0) then + print *, 'Angle is acute' +else if (angle < 180.0) then + print *, 'Angle is obtuse' +else + print *, 'Angle is reflex' +end if ``` When multiple conditional expressions are used, each conditional expression is tested only if none of the previous @@ -98,30 +98,32 @@ expressions have evaluated to true. ## Loop constructs (`do`) -In the following example a `do` loop construct is used to print out the numbers in +In the following example, a `do` loop construct is used to print out the numbers in a sequence. The `do` loop has an integer _counter_ variable which is used to track which iteration of the loop is currently executing. In this example we use a common name for this counter variable: `i`. -When we define the start of the `do` loop we use our counter variable name followed by an equals (`=`) sign +When we define the start of the `do` loop, we use our counter variable name followed by an equals (`=`) sign to specify the start value and final value of our counting variable. __Example:__ `do` loop ```fortran - integer :: i - do i=1,10 - print *, i - end do +integer :: i + +do i = 1, 10 + print *, i +end do ``` __Example:__ `do` loop with skip ```fortran - integer :: i - do i=1,10,2 - print *, i ! Print odd numbers - end do +integer :: i + +do i = 1, 10, 2 + print *, i ! Print odd numbers +end do ``` ### Conditional loop (`do while`) @@ -132,13 +134,14 @@ in `while()` evaluates to `.true.`. __Example:__ `do while()` loop ```fortran - integer :: i - i = 1 - do while (i < 11) - print *, i - i = i + 1 - end do - ! Here i = 11 +integer :: i + +i = 1 +do while (i < 11) + print *, i + i = i + 1 +end do +! Here i = 11 ``` ### Loop control statements (`exit` and `cycle`) @@ -148,74 +151,83 @@ with such cases. `exit` is used to quit the loop prematurely. It is usually enclosed inside an `if`. -__Example__ loop with `exit` +__Example:__ loop with `exit` ```fortran - integer :: i - do i=1, 100 - if (i > 10) then - exit ! Stop printing numbers - end if - print *, i - end do - ! Here i = 11 +integer :: i + +do i = 1, 100 + if (i > 10) then + exit ! Stop printing numbers + end if + print *, i +end do +! Here i = 11 ``` On the other hand, `cycle` skips whatever is left of the loop and goes into the next cycle. -__Example__ loop with `cycle` +__Example:__ loop with `cycle` ```fortran - integer :: i - do i=1,10 - if (mod(i,2) == 0) then - cycle ! Don't print even numbers - end if - print *, i - end do +integer :: i + +do i = 1, 10 + if (mod(i, 2) == 0) then + cycle ! Don't print even numbers + end if + print *, i +end do ``` -{% include note.html content="When used within nested loops, the `cycle` and `exit` statements operate on the inner-most loop." %} +{% include note.html content="When used within nested loops, the `cycle` and `exit` statements operate on the innermost loop." %} ### Nested loop control: tags A recurring case in any programming language is the use of nested loops. Nested loops refer to loops that exist within another loop. Fortran allows the programmer to _tag_ or _name_ each loop. If loops are tagged, there are two potential benefits: 1. The readability of the code may be improved (when the naming is meaningful). -2. `exit` and `cycle` may be used with tags, which allows for a very fine-grained control of the loops. +2. `exit` and `cycle` may be used with tags, which allows for very fine-grained control of the loops. -__Example__ tagged nested loops +__Example:__ tagged nested loops ```fortran - integer :: i,j - outer_loop: do i=1,10 - inner_loop: do j=1,10 - if ((j+i) > 10) then ! Print only pairs of i and j that add up to 10 - cycle outer_loop ! Go to the next iteration of the outer loop - end if - print *, 'I=', i, ' J=', j, ' Sum=', j+i - end do inner_loop - end do outer_loop +integer :: i, j + +outer_loop: do i = 1, 10 + inner_loop: do j = 1, 10 + if ((j + i) > 10) then ! Print only pairs of i and j that add up to 10 + cycle outer_loop ! Go to the next iteration of the outer loop + end if + print *, 'I=', i, ' J=', j, ' Sum=', j + i + end do inner_loop +end do outer_loop ``` ### Parallelizable loop (`do concurrent`) -The `do concurrent` loop is used to explicitly specify that the _inside of the loop has no interdependencies_; this informs the compiler that it may use parallelization/_SIMD_ to speed-up execution of the loop and conveys programmer intention more clearly. More specifically, this means -that any loop iteration does not depend on the prior execution of other loop iterations. It is also necessary that any state changes that may occur must only happen within each `do concurrent` loop. +The `do concurrent` loop is used to explicitly specify that the _inside of the loop has no interdependencies_; this informs the compiler that it may use parallelization/_SIMD_ to speed up execution of the loop and conveys programmer intention more clearly. More specifically, this means +that any given loop iteration does not depend on the prior execution of other loop iterations. It is also necessary that any state changes that may occur must only happen within each `do concurrent` loop. These requirements place restrictions on what can be placed within the loop body. -{% include important.html content="`do concurrent` is not a basic feature of Fortran. The explanation given does not detail -all the requirements that need to be met in order to write a correct `do concurrent` loop. Compilers are also free to do as they see fit, -which means they may not optimize the loop." %} +{% capture note %} +Simply replacing a `do` loop with a `do concurrent` does not guarantee parallel execution. +The explanation given above does not detail all the requirements that need to be met in order to write a correct `do concurrent` loop. +Compilers are also free to do as they see fit, meaning they may not optimize the loop (e.g., a small number of iterations doing a simple calculation, like the below example). +In general, compiler flags are required to activate possible parallelization for `do concurrent` loops. +{% endcapture %} +{% include important.html content=note %} -__Example__ `do concurrent()` loop +__Example:__ `do concurrent()` loop ```fortran - real, parameter :: pi = 3.14159265 - integer, parameter :: n = 10 - real :: result_sin(n) - integer :: i - do concurrent (i=1:n) ! Careful, the syntax is slightly different - result_sin(i) = sin(i*pi/4.) - end do - print *, result_sin +real, parameter :: pi = 3.14159265 +integer, parameter :: n = 10 +real :: result_sin(n) +integer :: i + +do concurrent (i = 1:n) ! Careful, the syntax is slightly different + result_sin(i) = sin(i * pi/4.) +end do + +print *, result_sin ``` diff --git a/learn/quickstart/organising_code.md b/learn/quickstart/organising_code.md index a5b6ee5b0..383662d1b 100644 --- a/learn/quickstart/organising_code.md +++ b/learn/quickstart/organising_code.md @@ -9,15 +9,15 @@ _procedures_ that can be reused by _calling_ them from other sections of code. Fortran has two forms of procedure: -- __Subroutine:__ invoked by a `call` statement -- __Function:__ invoked within an expression or assignment to which it returns a value +- __Subroutine__: invoked by a `call` statement +- __Function__: invoked within an expression or assignment to which it returns a value Both subroutines and functions have access to variables in the parent scope by _argument association_; -unless the `VALUE` attribute is specified, this is similar to call by reference. +unless the `value` attribute is specified, this is similar to call by reference. ## Subroutines -The subroutine input arguments, known as _dummy arguments_ are specified in parentheses after the subroutine name; +The subroutine input arguments, known as _dummy arguments_, are specified in parentheses after the subroutine name; the dummy argument types and attributes are declared within the body of the subroutine just like local variables. __Example:__ @@ -28,11 +28,12 @@ subroutine print_matrix(n,m,A) implicit none integer, intent(in) :: n integer, intent(in) :: m - real, intent(in) :: A(n,m) + real, intent(in) :: A(n, m) integer :: i - do i=1,n - print *,A(i,1:m) + + do i = 1, n + print *, A(i, 1:m) end do end subroutine print_matrix @@ -40,7 +41,7 @@ end subroutine print_matrix Note the additional `intent` attribute when declaring the dummy arguments; this optional attribute signifies to the compiler whether the argument -is 'read-only' (`intent(in)`) 'write-only' (`intent(out)`) or 'read-write' (`intent(inout)`) within the procedure. +is ''read-only'' (`intent(in)`) ''write-only'' (`intent(out)`) or ''read-write'' (`intent(inout)`) within the procedure. In this example, the subroutine does not modify its arguments, hence all arguments are `intent(in)`. {% include tip.html content="It is good practice to always specify the `intent` attribute for @@ -51,12 +52,12 @@ We can call this subroutine from a program using a `call` statement: ```fortran program call_sub implicit none - - real :: mat(10,20) - + + real :: mat(10, 20) + mat(:,:) = 0.0 - call print_matrix(10,20,mat) + call print_matrix(10, 20, mat) end program call_sub ``` @@ -89,22 +90,23 @@ program run_fcn real :: v(9) real :: vector_norm - + v(:) = 9 - print *, 'Vector norm = ',vector_norm(9,v) + print *, 'Vector norm = ', vector_norm(9,v) end program run_fcn ``` -{% include tip.html content="It is good programming practice for functions not to modify their arguments - _i.e._ all function arguments should be `intent(in)` - such -functions are known as `pure` functions. Use subroutines if your procedure needs to modify its arguments." %} +{% include tip.html content="It is good programming practice for functions not to modify their arguments---that is, all function arguments should be `intent(in)`. +Such functions are known as `pure` functions. +Use subroutines if your procedure needs to modify its arguments." %} ## Modules -Fortran modules contain definitions that are made accessible to programs, procedures and other modules through the `use` statement. -They can contain data objects, type definitions, procedures and interfaces. +Fortran modules contain definitions that are made accessible to programs, procedures, and other modules through the `use` statement. +They can contain data objects, type definitions, procedures, and interfaces. - Modules allow controlled scoping extension whereby entity access is made explicit - Modules automatically generate explicit interfaces required for modern procedures @@ -115,27 +117,28 @@ within modules." %} __Example:__ ```fortran -module my_mod +module my_mod implicit none - private ! All entities are module-private by default + private ! All entities are now module-private by default public public_var, print_matrix ! Explicitly export public entities real, parameter :: public_var = 2 integer :: private_var - contains +contains - ! Print matrix A to screen - subroutine print_matrix(A) - real, intent(in) :: A(:,:) ! An assumed-shape dummy argument + ! Print matrix A to screen + subroutine print_matrix(A) + real, intent(in) :: A(:,:) ! An assumed-shape dummy argument + + integer :: i - integer :: i - do i=1,size(A,1) - print *,A(i,:) - end do + do i = 1, size(A,1) + print *, A(i,:) + end do - end subroutine print_matrix + end subroutine print_matrix end module my_mod ``` @@ -151,7 +154,7 @@ program use_mod use my_mod implicit none - real :: mat(10,10) + real :: mat(10, 10) mat(:,:) = public_var @@ -163,16 +166,16 @@ end program use_mod __Example:__ explicit import list ```fortran - use my_mod, only: public_var +use my_mod, only: public_var ``` __Example:__ aliased import ```fortran - use my_mod, only: printMat=>print_matrix +use my_mod, only: printMat=>print_matrix ``` -{% include note.html content="Each module should be written in a separate .f90 source file. Modules need to be compiled prior to any program units that `use` them." %} +{% include note.html content="Each module should be written in a separate `.f90` source file. Modules need to be compiled prior to any program units that `use` them." %} diff --git a/learn/quickstart/variables.md b/learn/quickstart/variables.md index 907a3418f..74614818b 100644 --- a/learn/quickstart/variables.md +++ b/learn/quickstart/variables.md @@ -5,7 +5,7 @@ permalink: /learn/quickstart/variables --- Variables store information that can be manipulated by the program. -Fortran is a '_strongly typed_' language, which means that each variable +Fortran is a _strongly typed_ language, which means that each variable must have a type. There are 5 built-in data types in Fortran: @@ -19,14 +19,14 @@ There are 5 built-in data types in Fortran: Before we can use a variable, we must _declare_ it; this tells the compiler the variable type and any other variable attributes. -{% include note.html content="Fortran is a statically typed language which means the type of each -variable is fixed when the program is compiled - variable types cannot change while the program is running." %} +{% include note.html content="Fortran is a _statically typed_ language, which means the type of each +variable is fixed when the program is compiled---variable types cannot change while the program is running." %} ## Declaring variables The syntax for declaring variables is: -```fortran +``` :: ``` @@ -52,7 +52,7 @@ end program variables ``` {% include note.html content="Fortran code is __case-insensitive__; you don't have to worry about the -capitalisation of your variable names but it's good practice to keep it consistent." %} +capitalisation of your variable names, but it's good practice to keep it consistent." %} Note the additional statement at the beginning of the program: `implicit none`. This statement tells the compiler that all variables will be explicitly declared; without @@ -68,11 +68,11 @@ Once we have declared a variable, we can assign and reassign values to it using __Example:__ variable assignment ```fortran - amount = 10 - pi = 3.141592 - frequency = (1.0,-0.5) - initial = 'A' - isOkay = .false. +amount = 10 +pi = 3.1415927 +frequency = (1.0, -0.5) +initial = 'A' +isOkay = .false. ``` Characters are surrounded by either single (`'`) or double quotes (`"`). @@ -92,11 +92,11 @@ This is commonly referred to as writing to `standard output` or `stdout`. We can use the `print` statement introduced earlier to print variable values to `stdout`: ```fortran - print *, 'The value of amount (integer) is: ',amount - print *, 'The value of pi (real) is: ',pi - print *, 'The value of frequency (complex) is: ',frequency - print *, 'The value of initial (character) is: ',initial - print *, 'The value of isOkay (logical) is: ',isOkay +print *, 'The value of amount (integer) is: ', amount +print *, 'The value of pi (real) is: ', pi +print *, 'The value of frequency (complex) is: ', frequency +print *, 'The value of initial (character) is: ', initial +print *, 'The value of isOkay (logical) is: ', isOkay ``` In a similar way, we can read values from the command window @@ -110,7 +110,7 @@ program read_value print *, 'Please enter your age: ' read(*,*) age - print *, 'Your age is: ',age + print *, 'Your age is: ', age end program read_value ``` @@ -143,7 +143,7 @@ program arithmetic real :: area real :: volume - pi = 3.141592 + pi = 3.1415927 print *, 'Enter cylinder base radius:' read(*,*) radius @@ -151,13 +151,13 @@ program arithmetic print *, 'Enter cylinder height:' read(*,*) height - area = pi*radius**2.0 - volume = area*height + area = pi * radius**2.0 + volume = area * height - print *, 'Cylinder radius is: ',radius - print *, 'Cylinder height is: ',height - print *, 'Cylinder base area is: ',area - print *, 'Cylinder volume is: ',volume + print *, 'Cylinder radius is: ', radius + print *, 'Cylinder height is: ', height + print *, 'Cylinder base area is: ', area + print *, 'Cylinder volume is: ', volume end program arithmetic ``` @@ -170,9 +170,9 @@ end program arithmetic ## Floating-point precision The desired floating-point precision can be explicitly declared using a `kind` parameter. -The `iso_fortran_env` intrinsic module provides kind parameters for the common 32bit and 64bit floating point types. +The `iso_fortran_env` intrinsic module provides `kind` parameters for the common 32-bit and 64-bit floating-point types. -__Example:__ explicit real kind +__Example:__ explicit real `kind` ```fortran program float use, intrinsic :: iso_fortran_env, only: sp=>real32, dp=>real64 @@ -181,15 +181,15 @@ program float real(sp) :: float32 real(dp) :: float64 - float32 = 1.0_sp ! Explicit suffix for literal constants + float32 = 1.0_sp ! Explicit suffix for literal constants float64 = 1.0_dp end program float ``` -{% include important.html content="Always use a `kind` suffix for floating point literal constants." %} +{% include important.html content="Always use a `kind` suffix for floating-point literal constants." %} -__Example:__ c-interoperable kinds +__Example:__ C-interoperable `kind`s ```fortran program float use, intrinsic :: iso_c_binding, only: sp=>c_float, dp=>c_double